複数のシートのデータを1つのシートにまとめる:Excel VBA入門 |
スポンサードリンク | |
データを1シートにまとめる | シートの並びが異なるとき |
列方向へコピーしてまとめたい? |
Sub sh_check() Dim newSh As String Dim Sh As Worksheet, myFlag As Boolean newSh = "全データ" '---まとめ用のシート名です myFlag = False '---まとめ用のシートが有ったら True /無かったら False にするフラッグです For Each Sh In ThisWorkbook.Worksheets If Sh.Name = newSh Then myFlag = True '----全データシートのデータをクリアし、先頭へ移動します Worksheets(newSh).Cells.ClearContents Worksheets(newSh).Move before:=Sheets(1) Exit For End If Next Sh '----全データシートを先頭へ追加します If myFlag = False Then ActiveWorkbook.Worksheets.Add(before:=Worksheets(1)).Name = newSh End If End Sub |
Sub matome() Dim i As Integer Dim lRow As Long, lCol As Long, lRow2 As Long Application.ScreenUpdating = False '----全データシートの有無をチェックします sh_check '----列見出しをコピーします Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A1") For i = 2 To Worksheets.Count With Worksheets(i) lRow = .Cells(Rows.Count, 1).End(xlUp).Row lCol = .Cells(1, Columns.Count).End(xlToLeft).Column '----シートのデータが2行以上の場合にコピーします If lRow >= 2 Then lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 .Activate .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1) End If End With Next i Worksheets(1).Activate Range("A1").Select Application.ScreenUpdating = True End Sub |
Sub matome2() Dim Sh Dim i As Integer Dim lRow As Long, lCol As Long, lRow2 As Long Application.ScreenUpdating = False '----全データシートの有無をチェックします sh_check '----列見出しをコピーします Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A1") '----コピーする順番にシート名を配列Shに登録します Sh = Array("Sheet1", "Sheet2", "Sheet3") For i = LBound(Sh) To UBound(Sh) With Worksheets(Sh(i)) lRow = .Cells(Rows.Count, 1).End(xlUp).Row lCol = .Cells(1, Columns.Count).End(xlToLeft).Column If lRow >= 2 Then lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 .Activate .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1) End If End With Next i Worksheets(1).Activate Range("A1").Select Application.ScreenUpdating = True End Sub |
Sub matome3() Dim Sh Dim i As Integer Dim lRow As Long, lCol As Long, lRow2 As Long Dim lCol2 As Long Application.ScreenUpdating = False '----全データシートの有無をチェックします sh_check '----コピーする順番にシート名を配列Shに登録します Sh = Array("Sheet1", "Sheet2", "Sheet3") For i = LBound(Sh) To UBound(Sh) With Worksheets(Sh(i)) lRow = .Cells(Rows.Count, 1).End(xlUp).Row lCol = .Cells(1, Columns.Count).End(xlToLeft).Column If lRow >= 2 Then lCol2 = Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column + 1 If lCol2 = 2 Then lCol2 = 1 .Activate .Range(Cells(1, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(1, lCol2) End If End With Next i Worksheets(1).Activate Range("A1").Select Application.ScreenUpdating = True End Sub |
スポンサードリンク
PageViewCounter
Since2006/2/27