Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(指定なし : Excel 2010)
任意の数のシートの特定の行をコピーして新しいシートにまとめる方法
投稿日時: 20/12/21 21:09:12
投稿者: あべの

教えてください。VBA初心者です。
 
フォーマットが同じ任意の数のシートの特定の行をコピーしてその行だけ新しいシートに順番に張り付けていきたいです。
例えば、個人ごとに月ごとの売り上げを記録しているシートがあるとして
一番最後の行Rows(13)にSUM関数でこれまでの売り上げを計算しているとして、
そのSUM関数が入っている13行目だけをコピーしていきたいです。
値だけわかればいいので、関数はコピーしなくてもいいです。
 
見出しみたいなものは、13行目に含まれているので必要なく、
ただ既存のすべてのシートの13行目を新しいシートに上から順番にはりつけていくイメージです。
 
年末のお忙しい時期にすみません、
よろしくお願いいたします。

回答
投稿日時: 20/12/21 22:43:05
投稿者: WinArrow
投稿者のウェブサイトに移動

オートフィルタは、知っていますか?
オートフィルタで、合計行だけ表示することができれば、
見えている行だけ、別シートに複写可能です。
 
まず、手操作で実行を確かめて、意図したことができたのでしたら、
その操作をマクロの記録でコードを作成しましょう。

投稿日時: 20/12/22 04:57:50
投稿者: あべの

WinArrow様
返信ありがとうございます。
オートフィルタは知っています。
すみません、ここに書くのに分かりやすい例えを考えて書いたつもりでしたが例えが悪かったです。
実際は、コピーしたい行が欄外というか、本体の表とくっついていなくて、セル毎にいろいろな関数が含まれています。
なんとなく、for erch〜nextとcopyで書くんだろうなというのはわかるんですが、そこまでで思考がとまってます。
それとも「見えてる行だけ複写する」ということなら、その行以外は消去して残りを積み上げていく方がいいんでしょうか。そうなるとコードの想像がつきません。

回答
投稿日時: 20/12/22 07:50:30
投稿者: WinArrow
投稿者のウェブサイトに移動

あべの さんの引用:

実際は、コピーしたい行が欄外というか、本体の表とくっついていなくて、セル毎にいろいろな関数が含まれています。

 
欄外ということば、本体表(上下に配置)との間には、空白行が存在すると考えられます。
オートフィルタは、シートに1つしか設定できませんが、
同時でなければ、表を変えることができます。
 
あべの さんの引用:

なんとなく、for erch〜nextとcopyで書くんだろうなというのはわかるんですが、そこまでで思考がとまってます。
それとも「見えてる行だけ複写する」ということなら、その行以外は消去して残りを積み上げていく方がいいんでしょうか。そうなるとコードの想像がつきません。

 
Forループでセルを対象にシートを操作することは、
処理時間が掛かかります、(目に見えるかは別)
 
>対象外の行は消去
この消去には、疑問があります。関数に影響が出なければよいのですが、
 
Excelが用意したツールを使う方が最も効率的です。

回答
投稿日時: 20/12/22 09:28:08
投稿者: WinArrow
投稿者のウェブサイトに移動

>ただ既存のすべてのシートの13行目を新しいシートに上から順番にはりつけていくイメージです。
 
この条件だけで参考コードを提示します。
 

Sub 各シートの13行目だけを新規シートに複写する()
Dim NewSheet As Worksheet, scnt As Long

    With ActiveWorkbook
        If .Sheets(.Sheets.Count).Name <> "NEW" Then
            .Sheets.Add after:=.Sheets(.Sheets.Count)
            Set NewSheet = ActiveSheet
            NewSheet.Name = "NEW"
        Else
            Set NewSheet = .Sheets(.Sheets.Count)
        End If
        NewSheet.Activate
        For scnt = 1 To .Sheets.Count - 1
            If .Sheets(scnt).Name = "NEW" Then Exit For
            .Sheets(scnt).Rows(13).Copy
            NewSheet.Range("A" & NewSheet.Rows.Count).End(xlUp).Offset(1).EntireRow.PasteSpecial (xlPasteValues)
        Next
    End With
End Sub

回答
投稿日時: 20/12/24 10:30:48
投稿者: mattuwan44

>任意の数のシートの特定の行をコピーしてその行だけ新しいシートに順番に張り付けていきたい
 

Sub test()
    Dim ws As Worksheet
    Dim wsResult As Worksheet
    Dim ixRow As Long
    
  '新しいシートの挿入
    With Worksheets
        Set wsResult = .Add(after:=.Item(.Count))
    End With
  '貼り付け行番号初期値
    ixRow = 2
    
    '各シートの繰り返し
    For Each ws In Worksheets
        '新しいシート以外なら
        If Not ws Is wsResult Then
            'コピー
            ws.Rows(3).Copy
            '値のみ貼り付け
            wsResult.Rows(ixRow).PasteSpecial xlPasteValues
            '次の貼り付け先の行番号
            ixRow = ixRow + 1
        End If
    Next
End Sub

 
こういうことかな?

投稿日時: 20/12/25 06:23:01
投稿者: あべの

お二方、ありがとうございます。
書き込みに気づくのが遅れ、お礼が遅くなり申し訳ありません。
 
また仕事の都合で教えて頂いたものを試すのが月曜以降になってしまいます。また結果を後日ご報告いたします。
ありがとうございました。

トピックに返信