EXCEL、VBA

【VBA】シートをコピーする（同じブック、違うブック）

 

シートをコピーする構文

早速結論です。シートの最大列数を取得するには次の構文を使用します。

'1.「コピーしたいシート」を「コピー先のシート名の左」にコピーする
Worksheets("コピーしたいシート名").Copy Before:=Worksheets("コピー先のシート名")
'例：Sheet2をSheet5の左にコピーする
Worksheets("Sheet2").Copy Before:=Worksheets("Sheet5")


'2.「コピーしたいシート」を「コピー先のシート名の右」にコピーする
Worksheets("コピーしたいシート名").After Before:=Worksheets("コピー先のシート名")
'例：Sheet2をSheet5の右にコピーする
Worksheets("Sheet2").Copy After:=Worksheets("Sheet5")


'3.「コピーしたいシート」を先頭にコピーする
Worksheets("コピーしたいシート名").Copy Before:=Worksheets(1)
'例：Sheet3を先頭にコピーする
Worksheets("Sheet3").Copy Before:=Worksheets(1)


'4.「コピーしたいシート」を末尾（一番右）にコピーする
Worksheets("コピーしたいシート名").Copy After:=Worksheets(Worksheets.Count)
'例：Sheet3を末尾（一番右のシート）にコピーする
Worksheets("Sheet3").Copy After:=Worksheets(Worksheets.Count)

 

 

シートをコピーする（同じブック）

同じブック内でシートをコピーする関数です。

引数　fromSheet：コピー元のシート名

引数　toSheet：コピー後のシート名

引数　position：コピー後のシート位置（1:コピー元シートの前、2:コピー元シートの後、3：先頭、4:末尾、※指定しない場合は2）

戻り値　True：成功/ False：失敗

備考　コピー後のシート名がすでに存在する時、コピーはするが同じ名前にはならず、コピー元シートに（２）等がついてコピーされる

Public Function copyWorksheet(ByVal fromSheet As String, ByVal toSheet As String, Optional ByVal position As Integer = 2) As Boolean

On Error GoTo Catch

    'コピー
    Select Case position
        Case 1  'コピー元シートの前
           Worksheets(fromSheet).Copy Before:=Worksheets(fromSheet)
        Case 2  'コピー元シートの後
           Worksheets(fromSheet).Copy After:=Worksheets(fromSheet)
        Case 3  '先頭
           Worksheets(fromSheet).Copy Before:=Worksheets(1)
        Case 4  '末尾
           Worksheets(fromSheet).Copy After:=Worksheets(Worksheets.count)
        Case Else  'コピー元シートの後
           Worksheets(fromSheet).Copy After:=Worksheets(fromSheet)
    End Select
    
    'シート名を変更
    ActiveSheet.Name = toSheet
    copyWorksheet = True
    Exit Function

Catch:
    copyWorksheet = False

End Function

 

実行例

Debug.Print copyWorksheet("Sheet1", "Sheet2", 2)
' True

Debug.Print copyWorksheet("Sheet1", "Sheet3", 3)
' False

 

 

シートをコピーする（違うブック）

同じブック内でシートをコピーする関数です。

引数　fromSheet：コピー元のシート名

引数　toWB：コピー先のブック

引数　position：コピー先シート位置（1：先頭、2:末尾、指定しない場合:2）

戻り値　True：成功/ False：失敗

Public Function copyWorksheet2(ByVal fromSheet As Worksheet, ByVal toWB As Workbook, Optional ByVal position As Integer = 2) As Boolean

On Error GoTo Catch

    'コピー
    Select Case position
        Case 1  '先頭
            fromSheet.Copy Before:=toWB.Worksheets(1)
        Case 2  '末尾
            fromSheet.Copy After:=toWB.Worksheets(toWB.Worksheets.count)
        Case Else  '末尾
            fromSheet.Copy After:=toWB.Worksheets(toWB.Worksheets.count)
    End Select

    'シート名を変更
    copyWorksheet2 = True
    Exit Function

Catch:
    copyWorksheet2 = False

End Function

 

実行例

Dim wb As Workbook
Set wb = Workbooks.Add
Call copyWorksheet2(ThisWorkbook.Sheets("Sheet1"), wb, 2)