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
Author And Source
この問題について(Excelのワークシートをまとめる関数), 我々は、より多くの情報をここで見つけました https://qiita.com/nakashima_bike/items/adf406e72391b0a3b882著者帰属:元の著者の情報は、元のURLに含まれています。著作権は原作者に属する。
Content is automatically searched and collected through network algorithms . If there is a violation . Please contact us . We will adjust (correct author information ,or delete content ) as soon as possible .