質問: 2 '※ Cells(r, 1).Offset(ad).Select '※ ActiveSheet.Paste End If Next Next Sheets(1).Columns.AutoFit End Sub
回答: 食が必ずシート名の最後に来るなら問題ありませんがその条件だとそれ以外が一致しません。 また全シート分コピーされてしまうのは、 シート名の判定のIF文内のFor文で全シート分処理を回してしまっているからでしょう。 外側のFor文で全シート分処理を回しているのでそちらを利用すればいいと思います。 ``` Sub Test() Dim aws As Worksheet, ws As Worksheet Dim wsname As String Dim copyRow As Long wsname = "食" 'ActiveSheetをコピー先シートとする Set aws = ActiveSheet aws.Cells.Clear 'コピー行位置 copyRow = 1 For Each ws In Worksheets 'シート名が"*食*"にLIKE一致する場合 If ws.Name Like "*" & wsname & "*" Then 'ループさせているシートの入力範囲をコピー先シートのコピー行、A列にコピー ws.UsedRange.Copy Destination:=aws.Cells(copyRow, "A") 'コピー行位置にループさせているシートの入力範囲の最終行数を加算 copyRow = copyRow + ws.UsedRange.Rows.Count End If Next ws aws.Columns.AutoFit End Sub ```