| |
VBA初心者で申し訳ないのですが、複数のブックのある指定範囲から１つのシートに並べていくのに、とあるサイトから下記コードでやってみたところ、コピーは上手くできました。
ただ、実行するたびにどんどん下に追加されていきます。
もしセルの内容が同じだった場合、それは追加されず新規内容のみ追加されるようにするにはどのようにすればよろしいのでしょうか？
説明が下手で申し訳ないのですが、宜しくお願いします。
Sub 複数のファイルを一つに()
Dim theName As String 'ブック名の保存用
Dim theDir As String 'パスの保存用
Dim theBook As Workbook '開いたブックの保存用
Dim flg As Boolean '1件目かどうかの識別用
flg = True
Application.ScreenUpdating = False
'現在のカレントパスのtenkiフォルダに移動する
theDir = ThisWorkbook.Path & "\tenki"
'(1) 拡張子xlsのファイル名を取り出す
theName = Dir(theDir & "\*.xls")
'(2) 最後のファイル名を取り出すまで繰り返す
Do While theName <> ""
'取り出したファイル名を指定してオープン
Set theBook = Workbooks.Open(theDir & "\" & theName)
'サブプロシージャへ
Call subTenki(theBook, flg)
flg = False
theBook.Close
theName = Dir
Loop
End Sub
'---開いたブックのアクティブセル領域をコピーする（サブプロシージャ）
Sub subTenki(theBook As Workbook, flg As Boolean)
Dim thetbl As Range, LRow As Long
Set thetbl = theBook.Sheets(1).Range("A3:B6")
'コピーする
thetbl.Copy
With ThisWorkbook.ActiveSheet
'(3) 転記先のシートのどの行までデータが入っているかを調べる
LRow = .Range("A65536").End(xlUp).Row
If LRow = 1 Then
.Range("A" & LRow).PasteSpecial xlPasteValues
Else
.Range("A" & LRow + 1).PasteSpecial xlPasteValues
End If
End With
Application.CutCopyMode = False
End Sub
|
|
熊
- 11/8/23(火) 12:06 -
