Excelのループの使い方がわかりません

質問

使用しているエクセルのバージョンは2003です。
ファイル名がa～xまであるcsvファイルを順番に開いて特定の範囲をコピーして
別のエクセルブックの特定の範囲に張り付ける作業をVBAを使って組みたいのですが
いまいち分りません。ご指導のほどよろしくお願いします。
WS1は別のエクセルブックを指しています。

Workbooks.Open "a.csv"
Worksheets(a).Range("B2:O3").Copy WS1.Range("F7:S8")
Worksheets(a).Range("B4:O5").Copy WS1.Range("F10:S11")
Worksheets(a).Range("B6:O7").Copy WS1.Range("F13:S14")
Worksheets(a).Range("B8:O10").Copy WS1.Range("F16:S18")
Windows("a.csv").Activate
ActiveWindow.Close

Workbooks.Open "b.csv"
Worksheets(b).Range("B2:O3").Copy WS1.Range("F21:S22")
Worksheets(b).Range("B4:O5").Copy WS1.Range("F24:S25")
Worksheets(b).Range("B6:O7").Copy WS1.Range("F27:S28")
Worksheets(b).Range("B8:O10").Copy WS1.Range("F30:S32")
Windows("b.csv").Activate
ActiveWindow.Close

Workbooks.Open "c.csv"
Worksheets(c).Range("B2:O3").Copy WS1.Range("F35:S36")
Worksheets(c).Range("B4:O5").Copy WS1.Range("F38:S39")
Worksheets(c).Range("B6:O7").Copy WS1.Range("F41:S42")
Worksheets(c).Range("B8:O10").Copy WS1.Range("F44:S46")
Windows("c.csv").Activate
ActiveWindow.Close

Workbooks.Open "d.csv"
Worksheets(d).Range("B2:O3").Copy WS1.Range("F49:S50")
Worksheets(d).Range("B4:O5").Copy WS1.Range("F52:S53")
Worksheets(d).Range("B6:O7").Copy WS1.Range("F55:S56")
Worksheets(d).Range("B8:O10").Copy WS1.Range("F58:S60")
Windows("d.csv").Activate
ActiveWindow.Close
これがファイルxまで続きます。

回答No.2

shinyat1

参考になれば・・・シートにファイルをドラッグ＆ドロップするとコピーするマクロです。
A2セルからAAの最下行までをマクロブックに追加します。
CSV確認用固定文字は、ファイル確認するため、B1セルに入っている値を確認しているだけですので、いらないかも知れません。

******　ThisWorkbookの中に以下のコード　******
Private Sub Workbook_Deactivate()
Call Dataadd
End Sub

******　標準モジュールに以下のコード　******
Sub Dataadd()

Dim LastRow As Integer, Sheetname As String, Bookname As String, NRow As Integer
Dim O_LastRow As Integer, O_Sheetname As String, O_Bookname As String, O_Folder As String
Dim a As Variant, b As Variant

Application.ScreenUpdating = False
Bookname = ThisWorkbook.Name
O_Bookname = ActiveWorkbook.Name
O_Sheetname = ActiveSheet.Name

If Bookname <> O_Bookname Then
If Workbooks(O_Bookname).Worksheets(O_Sheetname).Range("B1").Value = "CSV確認用固定文字" Then

LastRow = Workbooks(Bookname).Sheets(1).Range("A65536").End(xlUp).Row
NRow = LastRow + 1
O_LastRow = Range("A65536").End(xlUp).Row '最下行を取得

Set a = Workbooks(O_Bookname).Worksheets(O_Sheetname).Range("A2:AA" & O_LastRow) 'UsedRange
Set b = Workbooks(Bookname).Sheets(1).Range("A" & NRow)

a.Copy (b)

Set a = Nothing
Set b = Nothing

Workbooks(O_Bookname).Activate
O_Folder = ActiveWorkbook.Path
ActiveWindow.Close

Cells.Font.Size = 10

'Kill (O_Folder & "\" & O_Bookname)　'コピー元ファイルを削除

End If
End If

Application.ScreenUpdating = True
End Sub