[[20231212191450]]　『マクロ　複数シートを一つにまとめる』（業務改善中）　ページの最後に飛ぶ

『マクロ　複数シートを一つにまとめる』（業務改善中）

こんばんは。
複数シートのデータを一つのシートにまとめたいと思い、こちらの過去の掲示板よりコードを活用させて頂きました。
各シートの５行目からまとめるには、どのように変更をしたら良いか教えて頂きたいです。
何卒、宜しくお願い致します。

Sub 全データ集計()

   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("A:O"), w.Rows("1:" & Last_row)).Copy Shuukei_cell.EntireRow.Cells(2, 1)
          End If
      Next

End Sub

＜使用 Excel：unknown、使用 OS：Windows11 ＞

 常識的にはこんなもんでしょう。
 旨く行かない場合は、データがどうなっているのか、それを説明してください。

 Sub 全データ集計()
     Dim WsShuukei As Worksheet
     Dim w As Worksheet
     Dim Last_row

     Set WsShuukei = Worksheets("全データ")

     For Each w In Worksheets
         If w.Name <> "全データ" Then
             With w
                 Last_row = .Cells(.Rows.Count, "A").End(xlUp).Row
                 If Last_row >= 5 Then
                      w.UsedRange.Offset(4).Copy WsShuukei.Cells(.Rows.Count, "A").End(xlUp).Offset(1)
                 End If
             End With
         End If
     Next w
 End Sub

（半平太） 2023/12/12(火) 20:29:09

半平太さま

ご返信頂きありがとうございます。

実行してみたところ、A列の最終セルが空白の所が集計されませんでした。
もしA列以外の列に情報が入力されているのであれば、集計して頂くことは可能でしょうか？
もしくはA列ではなくE列の最終セルで集計でも良いです。上記コードをA⇒Eへ変更したのですが、上手くいきませんでした。

お手数ですが、宜しくお願い致します。

（業務改善中） 2023/12/13(水) 09:18:48

 ＞E列の最終セルで集計でも良いです。

 E列を見に行けばいいと言うことなら、

 Sub 全データ集計()
     Dim WsShuukei As Worksheet
     Dim w As Worksheet
     Dim SrcLast_row As Long, Target_row As Long

     Set WsShuukei = Worksheets("全データ")
     WsShuukei.UsedRange.ClearContents

     For Each w In Worksheets

         If w.Name <> "全データ" Then
             SrcLast_row = w.Cells(w.Rows.Count, "E").End(xlUp).Row

             If SrcLast_row >= 5 Then
                 With WsShuukei.Cells(w.Rows.Count, "E").End(xlUp)
                     Target_row = IIf(.Value = "", 0, 1) + .Row
                 End With

                 w.Rows(5).Resize(SrcLast_row - 4).Copy WsShuukei.Cells(Target_row, "A")
             End If
         End If
     Next w
 End Sub

（半平太） 2023/12/13(水) 09:57:55

半平太さま

ありがとうございます！！
重い通りの結果となりました。

もう一つご要望があるのですが、集計する「全データ」の右のシート(各メーカー)を集計するというのは可能でしょうか？
シートの並びが左から「記入例、全データ、各メーカー・・・」となっており、一番左端の記入例は集計して欲しくないです。

何卒、宜しくお願い致します。
（業務改善中） 2023/12/13(水) 10:41:07

 Sub 全データ集計()'全データ集計シートより右だけ
     Dim WsShuukei As Worksheet
     Dim w As Worksheet
     Dim SrcLast_row As Long, Target_row As Long
     Dim Idx As Long

     Set WsShuukei = Worksheets("全データ")
     WsShuukei.UsedRange.ClearContents

     For Idx = WsShuukei.Index + 1 To Worksheets.Count
         Set w = Worksheets(Idx)
         SrcLast_row = w.Cells(w.Rows.Count, "E").End(xlUp).Row

         If SrcLast_row >= 5 Then
             With WsShuukei.Cells(w.Rows.Count, "E").End(xlUp)
                 Target_row = IIf(.Value = "", 0, 1) + .Row
             End With

             w.Rows(5).Resize(SrcLast_row - 4).Copy WsShuukei.Cells(Target_row, "A")
         End If
     Next Idx
 End Sub

（半平太） 2023/12/13(水) 15:15:31

半平太さま

おはようございます。
ご返信ありがとうございます。

バッチリです！
何かとご要望にお応え頂きましてありがとうございます。
とても助かります。

（YYY） 2023/12/14(木) 08:57:52

コメント返信：

[ 一覧(最新更新順) ]

[[20231212191450]] 『マクロ 複数シートを一つにまとめる』（業務改善中） ページの最後に飛ぶ

[[20231212191450]]　『マクロ　複数シートを一つにまとめる』（業務改善中）　ページの最後に飛ぶ