みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルのマクロで各Sheetのデータを複数コピー&ペーストしたいです

エクセルのマクロで各Sheetのデータを複数コピー&ペーストしたいです
1つのエクセルファイルの中に複数のSheetがあります。
各Sheetの4行目以降(5行目から)にデータのあるA列~O列をコピーしていって、
挿入-ワークシート(Sheet1という名前で構わない)に全てを順番にコピーしていきたいです。
”新しいマクロの記録”で下記のように作成したのですが、
 ・5行目からデータのあるA列~O列をコピーしていく 
 ・存在する全てのSheetから上記の作業をする
というマクロの書き方が分かりません。
恐れ入りますがお時間ある方で上記の内容をご理解頂ける方がいましたらアドバイス頂ければ非常に助かります。

Sub Macro1()
Sheets.Add
Sheets("ER10(zy)").Select
Rows("5:8").Select
Selection.Copy
Sheets("Sheet1").Select
ActiveSheet.Paste
Sheets("ER10(cx)").Select
Rows("5:9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A5").Select
ActiveSheet.Paste
Sheets("ER10(zht)").Select
Rows("5:13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A10").Select
ActiveSheet.Paste
End Sub

投稿日時 - 2010-11-04 21:13:21

QNo.6297328

困ってます

質問者が選んだベストアンサー

こちらに解説されています。
図は各シート行数固定の様な印象を与えますが、コードは最後の行位置を取得して処理しています。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_data_matome.html

投稿日時 - 2010-11-04 22:24:52

補足

たびたび申し訳ありません。
以下のマクロを使った場合にA列しかコピーしません。
これをA列~O列までをコピーするという指示を出したい場合どのようにすればいいでしょうか?

Sub matome()
 Dim i As Integer
 Dim lRow As Long, lCol As Long, lRow2 As Long
  Application.ScreenUpdating = False
   '----全データシートの有無をチェックします
  
  '----列見出しをコピーします
  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

投稿日時 - 2010-11-05 11:11:55

お礼

ありがとうございます。
頂いた内容をもとにマクロを作ったのですが、
重複していると言われます。
Sheet3つにしか対応していないようにも見えますが、私がしたい処理はSheetは10数枚以上あり、毎回Sheet数が違います。

投稿日時 - 2010-11-05 09:34:46

このQ&Aは役に立ちましたか?

2人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問