[[20190306120250]]　『複数シートから抽出』（akajus）　ページの最後に飛ぶ

『複数シートから抽出』（akajus）

初心者ですみません...教えてください。

sheet1～sheet11まで全て同じ様式のシートがあります。

sheet1

        A     B           C       D         E       F        G       H     ......    AB
5     番号1    番号2      名前       4月     リスト     5月      リスト   6月  ......    計
6     1.1.1     1                                                                                            
7     1.1.2     2                                                                        
8     1.1.3     3                                                                                    
9     1.1.4     4                                                                                    
.            .                    
.            .                    
.            .

※ AB5の"計"が10以上の行を別シートに抽出したい。10を含む
※ 抽出先のデータ名は"抽出データ"
※ A5の昇順になるように並べたい。sheet2のA5は2.1.1 sheet3のA5は3.1.1と規則的
※ 元データが変更になっても反映させたい。毎月入力するので、4月の時点で10になり、5月に1増えても抽出先も11になる、というような...
※ D5、F5、H5、、、と１つ飛ばしに月が入っており、以下に数字を入力して

   AB5以下が10以上になるもの。10になった時点で"抽出データ"に飛ぶように
※ AB列はsubtotal関数 
※ 抽出先のデータはA1～AB1のみ見出し

分かりづらく、すみません。
よろしくお願いします。

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

Sub main()

    Dim c As Range, i As Long
    Sheets("抽出データ").Cells.ClearContents
    Sheets("Sheet1").Rows(5).Copy Sheets("抽出データ").Range("A1")
    For i = 1 To 11
        For Each c In Sheets("Sheet" & i).Range("AB6:AB" & Rows.Count).SpecialCells(xlCellTypeFormulas)
            If c.Value >= 10 Then
                c.EntireRow.Copy Sheets("抽出データ").Range("A" & Rows.Count).End(xlUp).Offset(1)
            End If
        Next c
    Next i
End Sub
（mm） 2019/03/06(水) 13:59

mm様

本当に初歩的で申し訳ないのですが、
シート名を変更したい場合、上記マクロのどこを変更すればよろしいですか？
sheet1→元データ1 sheet2→元データ2 みたいな...

（akajus） 2019/03/06(水) 14:14

数的規則性があれば､

    For i = 1 To 11
        For Each c In Sheets("元データ" & i).Range("AB6:AB" & Rows.Count).SpecialCells(xlCellTypeFormulas)
            If c.Value >= 10 Then
                c.EntireRow.Copy Sheets("抽出データ").Range("A" & Rows.Count).End(xlUp).Offset(1)
            End If
        Next c
    Next i
なければ

    For Each sn In Array("元データA", "元データB", "元データX", "元データY")
        For Each c In Sheets(sn).Range("AB6:AB" & Rows.Count).SpecialCells(xlCellTypeFormulas)
            If c.Value >= 10 Then
                c.EntireRow.Copy Sheets("抽出データ").Range("A" & Rows.Count).End(xlUp).Offset(1)
            End If
        Next c
    Next sn
などでいかがですか？
（mm） 2019/03/06(水) 14:45

mm様
数的規則性がないので、下の方でやってみます！
ありがとうございます。
（akajus） 2019/03/07(木) 07:42

コメント返信：

[ 一覧(最新更新順) ]

[[20190306120250]] 『複数シートから抽出』（akajus） ページの最後に飛ぶ

[[20190306120250]]　『複数シートから抽出』（akajus）　ページの最後に飛ぶ