実務で使えるVBA

<<データを他ブックからコピー>>

'ファイル参照ダイアログの表示
filePath = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xls*")

'ファイル参照先をこのブックと同じ場所に設定する場合
'<<filePath = ThisWorkbook.Path & "\" & "test">>

Dim wbMoto, wbSaki As Workbook

'集計ツールをオブジェクトにセット
Set wbMoto = ActiveWorkbook

'追加リストブックを読み取り専用で開く
Set wbSaki = Workbooks.Open(filePath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)


'参照先の1～5番目までのシート上のデータをコピーする。
For i = 1 To 5

    'アクティブブックの最後尾を取得
    Row1 = wbMoto.Worksheets(1).Range("A100000").End(xlUp).Row

    '参照先データをアクティブブックに移す
    wbSaki.Worksheets(1).Range("A2:C1000").Copy
    wbMoto.Worksheets(1).Cells(Row1 + 1, 1).PasteSpecial xlPasteFormulasAndNumberFormats
    Application.CutCopyMode = False

Next i

'参照先ワークブックを閉じる
 wbSaki.Close

<<データを他ブックに丸ごと移す>>

Dim newBookName As String
Dim newBookPath As String
Dim newBook As Workbook

Dim today As Variant

'日付の表示を取得
today = Format(Date, "yyyymmdd")

'新しいファイルの名前を指定
newBookName = "test" & today

'新しいファイルのフルパスを設定
newBookPath = ThisWorkbook.Path & "\" & newBookName

'指定したパスにファイルが作成済でないかを確認。
If Dir(newBookPath) = "" Then
    '新しいファイルを作成
    Set newBook = Workbooks.Add

    '新しいファイルをVBAを実行したファイルと同じフォルダ保存
    newBook.SaveAs newBookPath

Else
    '既に同名のファイルが存在する場合はメッセージを表示
    MsgBox "既に" & newBookName & "というファイルは存在します。"

End If

'---------------------------------------------------以下、コピー＆ペースト処理-------------------------------------------------------

Dim SetFile As String
Dim wbMoto, wbSaki As Workbook

'コピー元のファイルをセット
Set wbMoto = ThisWorkbook

Application.DisplayAlerts = False

'コピー先のパス
SetFile = ThisWorkbook.Path & "\" & newBookName

'コピー先のファイルをセット
Set wbSaki = Workbooks.Open(SetFile)

'コピー元の集計表をコピー
wbMoto.Worksheets("test").Range("A1:E171").Copy

'コピー先にペースト
wbSaki.Worksheets("sheet1").Range("A1").PasteSpecial xlPasteFormats
wbSaki.Worksheets("sheet1").Range("A1").PasteSpecial xlPasteValues

'コピー先のシート名を変更
wbSaki.Sheets("Sheet1").name = "test"

'コピーの切り取り解除
Application.CutCopyMode = False

'コピー先の列幅を調整
Worksheets("test").Columns(1).ColumnWidth = 23
Worksheets("test").Range("B:E").Columns.AutoFit

'コピー先を保存
wbSaki.Save

'コピー先のファイルを閉じる
wbSaki.Close

Application.DisplayAlerts = True