|
失礼しました。
Sub test()
Dim myFile As String
Dim myWB As Workbook
Const myPath As String = "D:\年度集計"
Application.ScreenUpdating = False
myFile = Dir(myPath & "\" & "AAA*.xls")
If myFile = "" Then
MsgBox "AAAのつくファイルはありません。"
Else
With ThisWorkbook.Sheets("全件一覧")
.Cells.ClearContents
.Range("A1:C1").Value = Array("氏名", "男女", "県名")
End With
Do While myFile <> ""
Set myWB = Workbooks.Open(myPath & "\" & myFile)
With myWB.Sheets("一覧表")
.Range("A1", .Range("A65536").End(xlUp)).Resize(, 3).Copy
ThisWorkbook.Sheets("全件一覧").Range("A65536") _
.End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
End With
myWB.Close
myFile = Dir()
Loop
End If
Application.ScreenUpdating = True
Set myWB = Nothing
End Sub
|
|