[[20220226131212]]　『複数シートのデータを一つにまとめる　マクロ』（マクロ超初心者）　ページの最後に飛ぶ

『複数シートのデータを一つにまとめる　マクロ』（マクロ超初心者）

こんにちは。
複数シートのデータを一つにまとめるマクロを教えて頂きたいです。
ネットで探しで一括にまとめることはできたのすが、指定した列を抜き出すことが中々できません。

各シートの「CA～CGの列」だけのデータを抜き出しまとめたいです。
行は各シートバラバラですが列は同じです。

何卒、宜しくお願いします。

＜使用 Excel：Excel2007、使用 OS：Windows10 ＞

 ＞ネットで探して一括にまとめることはできたのすが

 そのコードをアップしてください。
 ※現物コードだと、支障が出る記述がある場合は、そこだけ無難な表記に変えてください。

（半平太） 2022/02/26(土) 13:55

半平太さま

ネットで探したのは下記となります。
どのように変更したら良いのかが分かりません。
列番号「CAやCG」を入力してみたのですが、上手くいきませんでした。
お手数ですが宜しくお願いします。

Sub shuukei_all()

  Dim Shuukei_cell
  Shuukei_cell = 1

  Dim w As Worksheet
  For Each w In Worksheets
    If w.Name <> "集計" Then
      Dim Last_row
      Last_row = w.Range("d" & Rows.Count).End(xlUp).Row
      Shuukei_cell = Range("a" & Rows.Count).End(xlUp).Row
      w.Rows("1:" & Last_row).Copy Range("a" & Shuukei_cell + 1)
    End If
  Next

End Sub

（マクロ超初心者） 2022/02/26(土) 14:00

  そのコードは、ちょっと危ないですよ。
  状況によっては、結果オーライなのかも知れませんが・・

  ＞ Last_row = w.Range("d" & Rows.Count).End(xlUp).Row
  コピー元シートD列の最終行を利用している。

  ＞Shuukei_cell = Range("a" & Rows.Count).End(xlUp).Row
  コピー先のA列で最終行を利用している。

  それそれの列が全てデータで埋まっているなら問題ないですが、
  一部空白があって、全体の最終列はもっと下にあると面倒なことになります。

  その点は問題ないですか？
  問題ないなら
  　↓
  Sub shuukei_all()
      Dim WsShuukei As Worksheet
      Dim Shuukei_cell
      Dim w As Worksheet
      Dim Last_row

      Set WsShuukei = Worksheets("集計")

      For Each w In Worksheets

          If w.Name <> "集計" Then
              Last_row = w.Range("D" & Rows.Count).End(xlUp).Row

              Shuukei_cell = WsShuukei.Range("A" & Rows.Count).End(xlUp).Row

              Intersect(w.Columns("CA:CG"), w.Rows("1:" & Last_row)).Copy WsShuukei.Range("A" & Shuukei_cell + 1)
          End If
      Next
  End Sub

（半平太） 2022/02/26(土) 14:31

 ＞ Shuukei_cell = WsShuukei.Range("A" & Rows.Count).End(xlUp).Row
 ＞ Intersect(w.Columns("CA:CG"), w.Rows("1:" & Last_row)).Copy WsShuukei.Range("A" & Shuukei_cell + 1)

 そこ、ちょっと無駄感が強いなぁ・・
 これの方が良さそう。

  Set Shuukei_cell = WsShuukei.Range("A" & Rows.Count).End(xlUp)
  Intersect(w.Columns("CA:CG"), w.Rows("1:" & Last_row)).Copy Shuukei_cell.Offset(1)

（半平太） 2022/02/26(土) 14:38

半平太さま

返信が遅くなりました。
無事きちんと集計することが出来ました！！
ありがとうございます！

今後のため、もし空白があった場合のバージョンも教えて頂けないでしょうか。
職場のチームで共有しているので、人によって入力の仕方が異なり空白があり
エラーを起こしかねない為です。
何卒、宜しくお願い致します。
（マクロ超初心者） 2022/02/26(土) 18:00

半平太さま

申し訳ございません。
きちんと確認してみた所、抽出されるデータが最初の１行のみしか抽出されません。
2行目以降の全てのデータが抽出されておりませんでした。
お手数ですが、ご確認頂けますでしょうか。
宜しくお願い致します。

（マクロ超初心者） 2022/02/26(土) 18:23

  ＞ご確認頂けますでしょうか。

  確認はできないです。データがどんな状況にあるのか説明がないので。

  これでどうですかね？

  Sub shuukei_all()
      Dim WsShuukei As Worksheet
      Dim Shuukei_cell As Range
      Dim w As Worksheet
      Dim Last_row

      Set WsShuukei = Worksheets("集計")

      For Each w In Worksheets

          If w.Name <> "集計" Then
              Set Shuukei_cell = WsShuukei.Cells.Find("*", WsShuukei.Range("A1"), xlValues, , xlByRows, xlPrevious)

              If Shuukei_cell Is Nothing Then
                  Set Shuukei_cell = WsShuukei.Range("A1")
              End If

              Last_row = w.Cells.Find("*", w.Range("A1"), xlValues, , xlByRows, xlPrevious).Row
              Intersect(w.Columns("CA:CG"), w.Rows("1:" & Last_row)).Copy Shuukei_cell.EntireRow.Cells(2, 1)
          End If
      Next
  End Sub

（半平太） 2022/02/26(土) 19:11

半平太さま

ありがとうございます！
空白セルや空白行があっても、きちんと全てのデータを抽出できました。
理想通りとなり業務がかなりはかどります。
本当にありがとうございました！感謝感謝です！！！
（マクロ超初心者） 2022/02/26(土) 19:46

コメント返信：

[ 一覧(最新更新順) ]

[[20220226131212]] 『複数シートのデータを一つにまとめる マクロ』（マクロ超初心者） ページの最後に飛ぶ

[[20220226131212]]　『複数シートのデータを一つにまとめる　マクロ』（マクロ超初心者）　ページの最後に飛ぶ