[[20200613152818]] 『VBA:コピーした行を別ファイルの最終行に張り付け』(じょあ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『VBA:コピーした行を別ファイルの最終行に張り付けるコード』(じょあ)

VBAのド素人ですがネットで調べながらコードを書いています。
一つのフォルダに複数のxlsxファイルがあり、1つの元ファイルのデータ(2行目以降すべての行)を削除し、複数の参照ファイルのデータ(2行目以降のすべての行)を元ファイルの最終行に張り付けるマクロを作りたいです。
1)元ファイルのデータを消す、2)複数の参照ファイルを開いてフィルタを外し必要な個所をコピーする、まではできたのですが、元ファイルの最終行へ貼り付け(paste)のコードがうまくいきません。(copyの後にpasteのコードを入れればよいと思うのですが。)
開いたファイルと元ファイルをうまく指定できていないからだと思うのですが、どなたかご助言いただけないでしょうか。

Sub DeleteExistingData()

    Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).EntireRow.Select 
    Selection.Delete Shift:=xlUp
End Sub

Sub 指定したPathの複数ファイルを開いてコピー()

    Path = "C:\Users\"
    buf = Dir(Path & "*.xlsx")
    Do While buf <> ""
    Workbooks.Open Path & buf
    If ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
    End If
    Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).EntireRow.Select
    Selection.Copy
'開いたファイルをClose
        ActiveWorkbook.Close
        buf = Dir()
    Loop
End Sub

< 使用 Excel:Office365、使用 OS:Windows10 >


>開いたファイルと元ファイルをうまく指定できていないからだと思うのですが、どなたかご助言いただけないでしょうか。
その通りだと思います。
あと、使う変数は宣言してから使ってください。
モジュール冒頭に「Option Explicit」と書いておくと、宣言していない変数を使うとエラーになるのでおすすめです。
あとはSelectしたものを次の行でSelection.(命令)するのも、ほぼ統合できるのでおすすめです。
このことをもとにコードを修正するとこんな感じです。

 Sub DeleteExistingData()
    ActiveSheet.Range("A2:A" & ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row).EntireRow.Delete Shift:=xlUp
End Sub
Sub 指定したPathの複数ファイルを開いてコピー()
    Dim Wb As Workbook
    Dim Sh As Worksheet
    Dim path As String
    Dim buf As String
    Set Sh = ThisWorkbook.ActiveSheet
    path = "C:\Users\"
    buf = Dir(path & "*.xlsx")
    Do While buf <> ""
        Set Wb = Workbooks.Open(path & buf)
        If Wb.ActiveSheet.FilterMode Then
            Wb.ActiveSheet.ShowAllData
        End If
        Wb.ActiveSheet.Range("A2:A" & Wb.ActiveSheet.Cells(Wb.ActiveSheet.Rows.Count, "A").End(xlUp).Row).EntireRow.Copy
        Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Offset(1).Paste
        '開いたファイルをClose
        Wb.Close
        buf = Dir()
    Loop
 End Sub

やたら長ったらしいですが、Withで省略することをしていなかったり、
Rows.Countのような省略してもあまり問題が起きないようなものにもつけていたりするのでこうなっています。
(Withについてはこちらを参照 http://officetanaka.net/excel/vba/beginner/16.htm )
シート名がわからないのでActivesheetをそのまま残していますが、できればこれも具体的なシート名(例:Worksheets("Sheet1"))の方ががおすすめです。
(のどあめ) 2020/06/13(土) 17:17


あとはインデントをつけることを強くおすすめします。
特にWithステートメントを使うときなど階層が複雑になるときこそおすすめです。
さっきのコードにWithを使うとこうです。

 Sub DeleteExistingData()
    With ActiveSheet
        .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).EntireRow.Delete Shift:=xlUp
    End With
 End Sub
 Sub 指定したPathの複数ファイルを開いてコピー()
    Dim Sh As Worksheet
    Dim path As String
    Dim buf As String
    Set Sh = ThisWorkbook.ActiveSheet
    path = "C:\Users\"
    buf = Dir(path & "*.xlsx")
    Do While buf <> ""
        With Workbooks.Open(path & buf)							'☆ 開いたブックのWith
            With .ActiveSheet								'◎ ☆開いたブックのアクティブシートのWith
                If .FilterMode Then
                    .ShowAllData
                End If
                .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).EntireRow.Copy
            End With									'◎終わり
            With Sh									'◇ Sh(ThisWorkbook.Activesheet)のWith ※☆とは階層になっていない
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Paste
            End With									'◇終わり
            '開いたファイルをClose
            .Close									'開いたブックが省略されている
        End With									'☆終わり
        buf = Dir()
    Loop
 End Sub

インデントをつけることで、Do〜LoopやIf〜End Ifの範囲、Withで何が省略されているのが一目瞭然になると思います。
(のどあめ) 2020/06/13(土) 17:32


のどあめ様。
2つもコメントいただき本当にありがとうございます。
最初に頂きましたコードで実行すると実行時エラー438が出てPasteの段階で止まってしまいました。
ご指摘のようにActivesheetになっているので、元ファイルではなく参照ファイルが開いた時にエラーになったのかと思い、
Set Sh = ThisWorkbook.ActiveSheetを
Set Sh = Workbooks("ファイル1.xlsx").WorkSheets("シート1") と指定したのですが、再度Pasteの行(Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Offset(1).Paste)に今度は実行時エラー13(型が一致しません)が出てしまいました。
私のシートの指定の仕方が悪いようです。

二回目に頂きましたコードもPasteの所でエラー438が出てしまいます。Shを指定しても同様でした。私の指定のエラー、提供情報不足だと思うのですが、追加でご助言いただけないでしょうか。
何卒宜しくお願い致します。

(じょあ) 2020/06/13(土) 18:15


だらだらと書いているうちにモロ被りのコメントついてますが、投稿しておきます。

■1
VBAの世界では、基本的にブックやシート、セルなど(オブジェクトといいます)を明示すれば、いちいちアクティブにしたり選択したりする必要はありません。

■2
「■1」と関連しますが、標準モジュールでシートを省略した記述をすると、アクティブシートを指定したものとしてみなされます。
したがって、複数のブックやシートを対象にする場合には、明確に記述すべきです。
(そうでないと、意図しないブックやシートを対象に操作してしまうため)

■3
最終行を調べる方法については、「VBA 最終行」みたいなキーワードでネット検索してみるとたくさん事例がみつかると思いますのて試してみてはどうでしょうか?

■4
提示されたコードについて、変数を宣言してませんが、こだわりがなければ宣言するようにしたほうが良いです。
http://officetanaka.net/excel/vba/variable/02.htm
http://officetanaka.net/excel/vba/beginner/06.htm

■5
踏まえて整理してみるとこんな感じじゃないでしょうか?

    Sub 実験01()
        Dim フォルダパス As String, ファイル名 As String
        Dim dstRNG As Range, 最終行 As Long

        Stop 'ブレークポイントの代わり

        フォルダパス = "C:\Users\"

        '▼「まとめ」シートの操作
        With ThisWorkbook.Worksheets("まとめ")
            '// 「まとめ」シートの項目行以外を削除する
            .UsedRange.Offset(1).Delete Shift:=xlUp

            '// 出力先を覚える
            Set dstRNG = .Range("B2")
        End With

        ファイル名 = Dir(フォルダパス & "*.xls?")
        Do While ファイル名 <> ""

            '▼ブックを開いて1番目のシートを操作対象にする
            With Workbooks.Open(フォルダパス & ファイル名).Worksheets(1)

                '// 対象シートの最終行を調べる
                最終行 = .Cells(.Rows.Count, "A").End(xlUp).Row

                '// 2行目以降にデータがある場合だけ処理する
                If 最終行 > 1 Then
                    With Intersect(.Range("2:" & 最終行), .UsedRange.EntireColumn)
                        .Copy dstRNG
                        dstRNG.Offset(, -1).Resize(.Rows.Count).Value = ファイル名

                        '// 出力先を覚えなおす
                        Set dstRNG = dstRNG.Offset(.Rows.Count)
                    End With
                End If

                '// ブックを閉じる
                Parent.Close
            End With

            ファイル名 = Dir()
        Loop
    End Sub

(もこな2 ) 2020/06/13(土) 19:05


すみません。こちらの記述間違いでした。
 With Sh
     .Cells(.Rows.Count, "A").End(xlUp).Offset(1).select
     .Paste
 End With

こう修正してください。
(のどあめ) 2020/06/13(土) 19:07


のどあめ様 早々にお返事いただきありがとうございました。
.selectだと上手く動かず、.pasteだけにしても動かなかったのですが、.PasteSpecial xlPasteAllにしたら上手く動きました。参照ファイルのデータが良く無かったのかもしれません。
withの使い方も含め大変勉強になりました。本当にありがとうございました。
初めて自分で書き始めたcodeだったのでできあがって感動しました。

もこな2様 当方まったくの素人なのでご助言いただきありがたいです。
頂きましたLinkを拝見して勉強致します。
(じょあ) 2020/06/13(土) 19:34

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.