|
ならば、
>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("一覧表")
> If .Range("A2").Value <> "" Then
.Range("A1", .Range("A65536").End(xlUp)).Resize(,2).Copy
> ThisWorkbook.Sheets("全件一覧").Range("A65536") _
> .End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
> End If
> End With
> myWB.Close
> myFile = Dir()
> Loop
> End If
> Application.ScreenUpdating = True
> Set myWB = Nothing
>
>End Sub
|
|