エクセルで複数ファイルからコピーをする。
すみませんが、BOOK1に複数のファイルから部分的にコピーして貼り付けるという作業をしたいのですが、ど素人なもんでわかりません。マクロで記録したモノをいじってみてるのですが、根本的にコードが分かっていなくギブアップです。
やりたいことは、フォルダーの中の970305日報1、970305日報2、970306日報1、970306日報2のようなファイルが山ほどあるのですが、
この970305の日報1と2を開き、それぞれファイルの決まった列を順番にをBook1の行へ行列を入れ替えて貼りつけていき(1日が1行)保存して閉じてから、次の日970306のデータをBOOK1の2行目に貼り付けるということをしたいのですが、どなたか教えていただければ助かります。よろしくお願いします。
Sub Macro2()
Dim MyFile As String, MyPath As String
Dim wb As Workbook, tb As Workbook
Set tb = ThisWorkbook
MyPath = tb.Path & "\"
MyFile = Dir(MyPath & "*.xls", vbNormal)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Do While MyFile <> ""
If MyFile <> tb.Name Then
Set wb = Workbooks.Open(MyPath & MyFile)
With ActiveSheet
Windows("970305日報1.xls").Activate
Range("B34:B38").Select
Application.CutCopyMode = False
Selection.Copy
Windows("日報リスト.xls").Activate
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteAll,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Windows("970305日報1.xls").Activate
Range("C33:C38").Select
Application.CutCopyMode = False
Selection.Copy
Windows("日報リスト.xls").Activate
Range("H1").Select
Selection.PasteSpecial Paste:=xlPasteAll,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
ActiveWorkbook.Save
Windows("970305日報1.xls").Activate
ActiveWindow.Close
Windows("970305日報2.xls").Activate
Range("B31:B36").Select
Selection.Copy
Windows("日報リスト.xls").Activate
Range("N1").Select
Selection.PasteSpecial Paste:=xlPasteAll,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Windows("970305日報2.xls").Activate
Range("D31:D36").Select
Application.CutCopyMode = False
Selection.Copy
Windows("日報リスト.xls").Activate
Range("T1").Select
Selection.PasteSpecial Paste:=xlPasteAll,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
ActiveWorkbook.Save
Windows("970305日報2.xls").Activate
ActiveWindow.Close
Windows("970306日報1.xls").Activate
Range("B34:B38").Select
Application.CutCopyMode = False
Selection.Copy
Windows("日報リスト.xls").Activate
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteAll,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Windows("970306日報1.xls").Activate
Range("C33:C38").Select
Application.CutCopyMode = False
Selection.Copy
Windows("日報リスト.xls").Activate
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteAll,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
ActiveWorkbook.Save
Windows("970306日報1.xls").Activate
ActiveWindow.Close
-----------------------------------------