[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『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 >
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
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
二回目に頂きましたコードも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.