Sub 済をショートカットで入力()
Dim sheetname As String
Dim ws As Worksheet
Dim lr As Long
sheetname = Worksheets("貼付").Range("B1").Value
Set ws = Worksheets(sheetname)
lr = ws.Cells(Rows.Count, 16).End(xlUp).Row
ws.Cells(lr + 1, 16).Select
ws.Cells(lr + 1, 16) = "問題無"
ws.Cells(lr + 2, 15).Select
ws.Cells(lr + 2, 15).Copy
End Sub
Sub 訴求漏れをショートカットで入力()
Dim sheetname As String
Dim ws As Worksheet
Dim lr As Long
sheetname = Worksheets("貼付").Range("B1").Value
Set ws = Worksheets(sheetname)
lr = ws.Cells(Rows.Count, 16).End(xlUp).Row
ws.Cells(lr + 1, 16).Select
ws.Cells(lr + 1, 16) = "訴求漏れ"
ws.Cells(lr + 2, 15).Select
ws.Cells(lr + 2, 15).Copy
End Sub
Sub 済を消す()
Dim sheetname As String
Dim ws As Worksheet
Dim lr As Long
sheetname = Worksheets("貼付").Range("B1").Value
Set ws = Worksheets(sheetname)
lr = ws.Cells(Rows.Count, 16).End(xlUp).Row
ws.Cells(lr, 16).Select
ws.Cells(lr, 16).ClearContents
ws.Cells(lr, 15).Select
ws.Cells(lr, 15).Copy
End Sub
Sub SortByColumnC()
Dim ws As Worksheet
Dim rng As Range
' 対象のシートを指定
Set ws = ThisWorkbook.Sheets("集計") ' Sheet1 を対象のシート名に変更してください
' ソート対象の範囲を指定
Set rng = ws.Range("A2:M1000")
' ソート
With ws.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("B2:B1000"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
.SetRange rng
.Header = xlNo
.MatchCase = False
.Apply
End With
End Sub