ここから本文です

VBAについて詳しい方いましたら、ご教示お願い致します。

sim********さん

2019/11/2716:01:28

VBAについて詳しい方いましたら、ご教示お願い致します。

ExcelVBAを使用して、別のBOOKの複数のシートから、
指定のセルの値が「0」以上の時(※常に5行間隔)、
空白のセルに当たるまで、このセルを含む下5行を繰り返し抽出したいです。
抽出するBOOK名は「エリア別売上表」です。

色々調べて作成してみたのですが、エラーだらけで初心者には作成できませんでした。。。

宜しくお願い致します。

補足画像を張り付けたのですが、見にくそうでしたので補足いたします。
指定のセル:R7から5行間隔
また抽出したい複数のシートは、全シート書式と配列法方は同じです。
貼り付け先のシートは、上にボタンを作成したいので、7行目から開始したいです。
宜しくお願い致します。

セル,Excel VBA,エリア別売上表,ご教示,エラーだらけ,Sub Sample1,myRow As Long

閲覧数:
128
回答数:
2
お礼:
250枚

違反報告

ベストアンサーに選ばれた回答

kai********さん

2019/11/2717:11:24

一例です。

不特定多数に参照されることは承知していますが、
コードを他の掲示板・スレ等へコピペすることは
お控えください。
利用する場合は、このスレのURLへの参照、
という形式でお願いします。


Sub Sample1()
Dim mySheet As Worksheet
Dim myEnd As Long, myRow As Long
Dim myPst As Long

'貼り付け先をクリア
With ThisWorkbook.ActiveSheet
.Rows("7:" & .Cells.Rows.Count).Delete
myPst = 7 '貼り付けスタート行
End With
With Workbooks("エリア別売上表")
For Each mySheet In .Worksheets
'除外シート条件があるなら加える
'-----
'最終行(G列で取得)
myEnd = mySheet.Cells(mySheet.Cells.Rows.Count, "G").End(xlUp).Row
'7行目より5行ごとに捜査
For myRow = 7 To myEnd Step 5
'R列の値>0 ならアクティブシートへコピペ
If mySheet.Cells(myRow, "R") > 0 Then
mySheet.Rows(myRow).Resize(5).Copy ThisWorkbook.ActiveSheet.Cells(myPst, 1)
myPst = myPst + 5 '貼り付け行をずらす
End If
Next myRow
Next mySheet
End With
End Sub



一例として参考程度に。

  • 質問者

    sim********さん

    2019/11/2717:34:26

    ご回答ありがとうございます!!
    実際のシート名などを張り付けてさっそく試してみたいのですが、
    >>'除外シート条件があるなら加える
    を、選択したシートから抽出する事は可能でしょうか?
    抽出したいシートよりも不要なシートが多いのですが、
    共有で使っているエクセルのため、今度シートが増える可能性が高いのと、シートの整理が出来ない状態です。
    お手数おかけしますが宜しくお願い致します。

  • その他の返信(3件)を表示

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2019/11/28 10:58:32

ありがとうございました!!!
無事に作成できました!

ベストアンサー以外の回答

1〜1件/1件中

プロフィール画像

カテゴリマスター

aka********さん

2019/11/2717:04:47

逆では むりですか
まず 全部コピーします
其の後 空白のセルなり 不要なものを削除する
この考えの方が いいよな 気がします。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる