Excelのワークシートをまとめる関数


ワークシートをまとめる

同じワークブックにある複数のシートをまとめる作業が多発するようになった。手作業でコピー&ペーストを繰り返していたが、作業ミスが発生したので自動化させることにした。

仕様

  • コピー先ワークシートの最後行の次行に追加される
  • ワークシートのA列で最終行を判断する
  • コピー開始行は1行目か2行目のみ指定可能
  • ペーストは値のみコピー
  • 何らかのエラーが発生した場合はマクロの戻り値がFalse

コード

'
'ワークシートを1つにまとめる
'DestSheet : まとめ先のシート
'SourceSheet : このシートをまとめ先シートの最後に追加する
'FirstLineInclude : 先頭行も含む 省略可 初期値はFalse=含まない
'
'ex) call VMakeOneSheet(WorkSheet1,WorkSheet2,True) 'WorkSheet2の先頭行を含めて、Worksheet1にコピーする
'
Public Function VMakeOneSheet(ByVal DestinationSheet As Worksheet, ByVal SourceSheet As Worksheet, Optional FirstLineInclude As Boolean = False) As Boolean
    On Error GoTo ErrorLabel

    Dim TargetLastRow As Long   'まとめ先シートの最終行=ここがコピー先の行番号
    Dim SourceStartRow As Long  'まとめ元シートの先頭行
    Dim SourceLastRow As Long   'まとめ元シートの最終行

    '初期化
    If FirstLineInclude = False Then
        SourceStartRow = 2
    Else
        SourceStartRow = 1
    End If

    '主処理
    'まとめ先のA列最終行を求める
    'まとめ元のA列最終行を求める
    'まとめ元のSourceRowNumberからA列最終行までをクリップボードにコピー
    'まとめ先のA列最終行+1にペースト

    'まとめ先のA列最終行を求める
    TargetLastRow = DestinationSheet.Cells(Rows.Count, "A").End(xlUp).Row
    'まとめ元のA列最終行を求める
    SourceLastRow = SourceSheet.Cells(Rows.Count, "A").End(xlUp).Row
    'まとめ元のSourceRowNumberからA列最終行までをクリップボードにコピー
    SourceSheet.Range(SourceStartRow & ":" & SourceLastRow).Copy
    'まとめ先のA列最終行+1にペースト
    '最終行が1行目なら(ワークシートが空白を想定)1行目にペースト
    If DestinationSheet.Cells(1, 1).Value = "" Then
        TargetLastRow = 1
    Else
        TargetLastRow = TargetLastRow + 1
    End If
    DestinationSheet.Cells(TargetLastRow, "A").PasteSpecial (xlPasteValues)

    '後処理
    Application.CutCopyMode = False 'コピーモード解除
    VMakeOneSheet = True

    Exit Function

ErrorLabel:
'    Debug.Print Err.Number
'    Debug.Print Err.Description

    VMakeOneSheet = False

End Function