Vba初心者です。下記のコード助けてください Loopに対するDoがありませんと表示されます Sub

Vba初心者です。下記のコード助けてください
Loopに対するDoがありませんと表示されます

Sub シール用データ①()
Dim folder As String
Dim wb As Workbook
Dim file As String
Dim r As Long
Dim ws As Worksheet
'
folder = "D:\工場伝票\①\" 'ファイルがあるフォルダ
'folder = ThisWorkbook.Path & "\" 'このBookのフォルダ
Set ws = ThisWorkbook.Sheets("Sheet1") 'このブックのSheet1(コピー先シート)
ws.Range("A2:C60").Clear 'コピー先シートクリア
r = 2 '出力行の初期値=1
file = Dir(folder & "*.xls*") 'フォルダ内の最初のブック名
Do While file <> "" 'ファイルがある間
If file <> ThisWorkbook.Name Then 'このブック(VBAのあるブック)でなければ
Set wb = Workbooks.Open(folder & file) 'ブックを開く
If r = 2 Then '出力行が1なら(最初なら)
wb.Sheets(3).Range("Q55").Copy
ws.Range("A" & r).PasteSpecial xlPasteValues '値をペースト
Application.CutCopyMode = False 'コピーを解除 '見出しコピー(1行)
wb.Sheets(3).Activate
Range("Q57").Copy
ws.Range("B" & r).PasteSpecial xlPasteValues '値をペースト
Application.CutCopyMode = False 'コピーを解除 '見出しコピー(1行)
wb.Sheets(3).Activate
Range("Q60").Copy
ws.Range("C" & r).PasteSpecial xlPasteValues '値をペースト
Application.CutCopyMode = False 'コピーを解除 '見出しコピー(1行)
r = r + 1
End If
Loop
End Sub

No.1 ベストアンサー 回答者： ママチャリ 回答日時： 2020/12/13 23:01

If file <> ThisWorkbook.Name　に対する End If が無いみたいですね！！

この回答へのお礼

アドバイスありがとうございました♪無事に解決できました

お礼日時：2020/12/15 13:17