【VBA】worksheetsのcopy(1:別ブック:シートをコピーして貼り付ける:複数シート:引数:プロパティなど)

' 基本構文
Worksheets("シート名").Copy Before:=コピー先, After:=コピー先

' 実際の使用例
Sub シートコピー基本()
    ' Sheet1をSheet2の前にコピー
    Worksheets("Sheet1").Copy Before:=Worksheets("Sheet2")
End Sub

Sub Before引数の使用例()
    ' 売上データシートを集計シートの前にコピー
    Worksheets("売上データ").Copy Before:=Worksheets("集計")
    
    ' コピーされたシートの名前を変更
    ActiveSheet.Name = "売上データ_コピー"
End Sub

Sub After引数の使用例()
    ' テンプレートシートを最後のシートの後ろにコピー
    Worksheets("テンプレート").Copy After:=Worksheets(Worksheets.Count)
    
    ' 今日の日付をシート名にする
    ActiveSheet.Name = "レポート_" & Format(Date, "yyyymmdd")
End Sub

Sub 引数省略時の動作()
    ' 引数を省略すると新規ブックが作成される
    Worksheets("顧客リスト").Copy
    
    ' この時点で新しいブックがアクティブになっている
    ActiveWorkbook.SaveAs "C:\作業フォルダ\顧客リスト_" & Format(Date, "yyyymmdd") & ".xlsx"
End Sub

Sub インデックスでコピー()
    ' 1番目のシートを2番目の位置にコピー
    Worksheets(1).Copy After:=Worksheets(1)
    
    ' コピーされたシートは自動的に2番目になる
    Worksheets(2).Name = "コピー_" & Worksheets(1).Name
End Sub

Sub シート名でコピー()
    Dim コピー元 As String
    
    ' シート名を変数に格納
    コピー元 = "月次レポート"
    
    ' 月次レポートを年間集計の前にコピー
    Worksheets(コピー元).Copy Before:=Worksheets("年間集計")
    
    ' 新しいシート名を設定
    ActiveSheet.Name = "月次レポート_" & Format(Date, "yyyy年mm月")
End Sub

Sub コピー後の名前変更()
    Dim 新シート名 As String
    Dim カウンター As Integer
    
    ' 元のシートをコピー
    Worksheets("商品マスタ").Copy After:=Worksheets("商品マスタ")
    
    ' 重複しない名前を生成
    カウンター = 1
    Do While シート名存在チェック("商品マスタ_" & カウンター)
        カウンター = カウンター + 1
    Loop
    
    ' 名前を設定
    ActiveSheet.Name = "商品マスタ_" & カウンター
End Sub

' シート名の存在チェック関数
Function シート名存在チェック(シート名 As String) As Boolean
    Dim ws As Worksheet
    
    シート名存在チェック = False
    For Each ws In Worksheets
        If ws.Name = シート名 Then
            シート名存在チェック = True
            Exit Function
        End If
    Next ws
End Function

Sub 新規ブックへコピー()
    Dim 元ブック As Workbook
    Dim 新ブック As Workbook
    
    ' 現在のブックを変数に格納
    Set 元ブック = ThisWorkbook
    
    ' シートをコピー(新規ブックが自動作成される)
    元ブック.Worksheets("出荷データ").Copy
    
    ' 新しく作成されたブックを変数に格納
    Set 新ブック = ActiveWorkbook
    
    ' 新規ブックを保存
    新ブック.SaveAs Filename:="C:\出荷データ\出荷データ_" & Format(Date, "yyyymmdd") & ".xlsx"
    新ブック.Close SaveChanges:=True
    
    ' 元のブックをアクティブに戻す
    元ブック.Activate
End Sub

Sub 既存ブックへコピー()
    Dim コピー元ブック As Workbook
    Dim コピー先ブック As Workbook
    
    ' コピー元のブックを設定
    Set コピー元ブック = ThisWorkbook
    
    ' コピー先のブックを開く
    Set コピー先ブック = Workbooks.Open("C:\集計フォルダ\年間集計.xlsx")
    
    ' シートをコピー(コピー先ブックの最後に追加)
    コピー元ブック.Worksheets("月次売上").Copy After:=コピー先ブック.Worksheets(コピー先ブック.Worksheets.Count)
    
    ' コピー先ブックを保存して閉じる
    コピー先ブック.Close SaveChanges:=True
    
    MsgBox "シートのコピーが完了しました", vbInformation
End Sub

Sub ブック指定でコピー()
    ' ブック名を指定してコピー
    ThisWorkbook.Worksheets("受注データ").Copy _
        Before:=Workbooks("管理台帳.xlsx").Worksheets(1)
    
    ' コピーされたシートはコピー先ブックの1番目になる
    Workbooks("管理台帳.xlsx").Worksheets(1).Name = "受注_" & Format(Date, "mmdd")
End Sub

Sub 連続シートコピー()
    ' 複数シートを配列で指定してコピー
    Worksheets(Array("キウイ売上", "パパイヤ売上", "マンゴー売上")).Copy
    
    ' 新規ブックが作成され、3つのシートがコピーされる
    ActiveWorkbook.SaveAs "C:\集計\果物売上_" & Format(Date, "yyyymmdd") & ".xlsx"
End Sub

Sub 条件付きシートコピー()
    Dim ws As Worksheet
    Dim 新ブック As Workbook
    Dim 初回フラグ As Boolean
    
    初回フラグ = True
    
    ' 全シートをループ
    For Each ws In ThisWorkbook.Worksheets
        ' シート名に「2024」が含まれるシートをコピー
        If InStr(ws.Name, "2024") > 0 Then
            If 初回フラグ Then
                ws.Copy
                Set 新ブック = ActiveWorkbook
                初回フラグ = False
            Else
                ws.Copy After:=新ブック.Worksheets(新ブック.Worksheets.Count)
            End If
        End If
    Next ws
    
    If Not 初回フラグ Then
        新ブック.SaveAs "C:\アーカイブ\2024年データ.xlsx"
    End If
End Sub

Sub 配列で複数シートコピー()
    Dim コピー対象 As Variant
    
    ' コピーしたいシート名を配列で定義
    コピー対象 = Array("ドラゴンフルーツ売上", "ライチ売上", "パッションフルーツ売上")
    
    ' 配列で指定したシートをコピー(新規ブック作成)
    Worksheets(コピー対象).Copy
    
    ' 保存
    ActiveWorkbook.SaveAs "C:\集計\エキゾチックフルーツ売上.xlsx"
End Sub

Sub エラー対処_インデックス()
    Dim シート名 As String
    Dim ws As Worksheet
    
    シート名 = "グアバ売上"
    
    ' エラー処理を設定
    On Error Resume Next
    Set ws = Worksheets(シート名)
    On Error GoTo 0
    
    ' シートの存在確認
    If ws Is Nothing Then
        MsgBox "シート「" & シート名 & "」が見つかりません", vbExclamation
        Exit Sub
    End If
    
    ' シートが存在する場合のみコピー
    ws.Copy After:=ws
    ActiveSheet.Name = シート名 & "_コピー"
End Sub

Sub エラー対処_オブジェクト未設定()
    Dim コピー先ブック As Workbook
    Dim ファイル名 As String
    
    ファイル名 = "集計ブック.xlsx"
    
    ' ブックが開いているか確認
    On Error Resume Next
    Set コピー先ブック = Workbooks(ファイル名)
    On Error GoTo 0
    
    ' ブックが開いていない場合は開く
    If コピー先ブック Is Nothing Then
        Set コピー先ブック = Workbooks.Open(ThisWorkbook.Path & "\" & ファイル名)
    End If
    
    ' 正常にブックが設定された場合の処理
    ThisWorkbook.Worksheets("データシート").Copy _
        After:=コピー先ブック.Worksheets(コピー先ブック.Worksheets.Count)
End Sub

Sub タイムスタンプで重複回避()
    Dim 元シート名 As String
    Dim 新シート名 As String
    
    元シート名 = "月次データ"
    
    ' タイムスタンプを使用してユニークな名前を生成
    新シート名 = 元シート名 & "_" & Format(Now, "yyyymmdd_hhnnss")
    
    ' シートをコピー
    Worksheets(元シート名).Copy After:=Worksheets(元シート名)
    
    ' 名前を設定
    ActiveSheet.Name = 新シート名
End Sub