同一フォルダに入っているファイルを縦に足したい。
VBAでは以下のコードにより実現できた。VBscriptでのコードをご教示願います。
Sub 複数ファイルappend()
Dim bk As String
Dim lastrow As Long
Dim lastrow2 As Long
Dim lastcolumn As Long
Dim fname As String
Const path = "C:\Users\Desktop\test" 'ファイルが格納されているフォルダを指定する
Application.ScreenUpdating = False
fname = Dir(path & "*.xls*") '該当フォルダに格納されているファイルすべてを対象
Do While fname <> "" '1つずつファイルを開いていく
Workbooks.Open path & "" & fname
With Workbooks(fname).Worksheets("Sheet1")
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row 'A列の下端セルを調査
lastcolumn = .Cells(1, Columns.Count).End(xlToLeft).Column '1行目の右端セルを調査
lastrow2 = Workbooks("VBAファイル.xlsm").Worksheets("Sheet1").Cells(Rows.Count, "E").End(xlUp).Row '貼付元ファイルの下端セルを調査
.Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy Workbooks("VBAファイル.xlsm").Worksheets("Sheet1").Range("E" & lastrow2) 'コピペ
Workbooks(fname).Close '開いたファイルを閉じる
fname = Dir()
End With
Loop
MsgBox ("貼付完了")
End Sub
回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2017/08/15 04:02