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

解決済みの質問

複数シートから空白ではない行をすべて抽出

タイトル行A1:D1、データの中身は、A2:D11の全く同じ様式のシートが複数あります。シート名はバラバラです。
全シートの空白ではない行を全て別の集計シートに抽出したいです。
空白行は抽出しません。
これを関数でどのようにつくればよいのでしょうか?
関数で無理ならVBAでお願いします。

大変申し訳ございませんが、この投稿に添付された画像や動画などは、「BIGLOBEなんでも相談室」ではご覧いただくことができません。 OKWAVEよりご覧ください。

マルチメディア機能とは?

投稿日時 - 2019-02-10 15:36:40

QNo.9586463

すぐに回答ほしいです

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

》 空白行は抽出しません。
なら、邪魔臭い12行目も抽出すると?

投稿日時 - 2019-02-10 16:00:56

ANo.2

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

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

回答(6)

ANo.6

参考に
Sub Test()
 Dim sh As Worksheet
 Dim flg As Boolean
 Dim LastRow As Long
 For Each sh In ActiveWorkbook.Worksheets
  If sh.Name = "集計" Then
   flg = True
  ElseIf flg = True Then
   LastRow = Sheets("集計").Cells(Rows.Count, "A").End(xlUp).Row + 1
   sh.Range("A2:D" & sh.Cells(Rows.Count, "D").End(xlUp).Row).Copy _
   Sheets("集計").Cells(LastRow, "A")
  End If
 Next
End Sub

投稿日時 - 2019-02-10 21:47:46

ANo.5

>最後のシートのものしか転記されないです。
当方で確認すると期待通り動作します。
複写元シートの2行目が空欄ということはないんですね?

もし、データの埋まる可能性のある行が2行目から11行目までで
かつ、上詰めでデータが埋まっていないのであれば、
Sub Sample2() を使ってみてください。

投稿日時 - 2019-02-10 19:56:28

お礼

ご回答ありがとうございます。
こちらの手違いでエラーが出ていました。
もう一度コードを読むと意味がわかったので、解決しました。本当にありがとうございます。

投稿日時 - 2019-02-10 22:06:24

ANo.4

別案を。

集計元のシートたちは3枚目以降、すべてのシート。
空白かどうかは
A列、B列ともに空欄ではない
という条件でいいですか。

また、集計元のシートの対象範囲は
必ず2行目から11行目までで
かつ、途中に空行があるのなら
以下のコードでいかがでしょうか。


Option Explicit

Sub Sample2()

 Dim GetShe As Worksheet
 Dim PutShe As Worksheet
 Dim SheCnt As Long
 Dim RowCnt As Long
 Dim PutRowCnt As Long
 
 SheCnt = ThisWorkbook.Sheets.Count
 Set PutShe = ThisWorkbook.Sheets("集計")
 
 PutRowCnt = 1
 For SheCnt = 3 To SheCnt
  Set GetShe = ThisWorkbook.Sheets(SheCnt)
  For RowCnt = 2 To 11
   If ((GetShe.Cells(RowCnt, 1) <> "") And _
     (GetShe.Cells(RowCnt, 2) <> "")) Then
    PutRowCnt = PutRowCnt + 1
    GetShe.Rows(RowCnt).Copy PutShe.Rows(PutRowCnt)
   End If
  Next RowCnt
 Next SheCnt

End Sub

投稿日時 - 2019-02-10 18:41:07

お礼

ご回答ありがとうございます。
こちらの手違いでエラーが出ていました。
別バージョンも示していただき勉強になります。

投稿日時 - 2019-02-10 22:06:06

ANo.3

集計元のシートたちは3枚目以降、すべてのシート。
空白かどうかは
A列、B列ともに空欄ではない
という条件でよければ
以下のコードでいかがでしょうか。

Option Explicit

Sub Sample()

 Dim GetShe As Worksheet
 Dim PutShe As Worksheet
 Dim SheCnt As Long
 Dim RowCnt As Long
 Dim ColCnt As Long
 Dim PutRowCnt As Long
 
 SheCnt = ThisWorkbook.Sheets.Count
 Set PutShe = ThisWorkbook.Sheets("集計")
 
 PutRowCnt = 1
 For SheCnt = 3 To SheCnt
  Set GetShe = ThisWorkbook.Sheets(SheCnt)
  RowCnt = 2
  Do
   If ((GetShe.Cells(RowCnt, 1) <> "") And _
     (GetShe.Cells(RowCnt, 2) <> "")) Then
    PutRowCnt = PutRowCnt + 1
    GetShe.Rows(RowCnt).Copy PutShe.Rows(PutRowCnt)
   Else
    Exit Do
   End If
   RowCnt = RowCnt + 1
  Loop
 Next SheCnt

End Sub

※私なら加えて、
集計シートの5列目に
集計元シートのシート名を格納します。

投稿日時 - 2019-02-10 18:28:01

補足

ご回答ありがとうございます。
最後のシートのものしか転記されないです。
例えば、1つ目のシートの転記で集計シート2行目から10行目まで使った場合、2つ目のシートの転記先は集計シート11行目からにしないといけないと思います。ご回答いただいたコードでは、コピペしたものが上書きされてしまい、最終シートのものしか残らなくなると思います。少しは読めても自分ではコードが書けないので、もしよろしければお願いします。

投稿日時 - 2019-02-10 18:57:36

お礼

ご回答ありがとうございます。
こちらの手違いでエラーが出ていました。
もう一度コードを読むと意味がわかったので、解決しました。本当にありがとうございます。

投稿日時 - 2019-02-10 22:05:40

ANo.1

 
私なら手動でします
1)京都のシートに移動
2)A2をクリックShftとCtrlを押しながら矢印キーの下、右と押す
3)Ctrl+C
4)集計シートを選択しA2をマウスでクリックしてEnter
・・・(これで京都シートの空白でない行がコピーされる)
5)大阪のシートを選択し2~4を繰り返す、ただし集計シートではA2出なくコピー済みの次の行をクリック
大阪シートが終われば他のシートも同様に行う
47都道府県全てのシートがあっても数分で終わります。
 

投稿日時 - 2019-02-10 15:50:15

補足

単純化したモデルです。
実際はもっと面倒なので、手動は困難です。

投稿日時 - 2019-02-10 17:00:47

あなたにオススメの質問