| |
Sub MyWorkbooks()
Dim sFolderName As String, sFileName As String
Dim WB As Workbook, Sh As Worksheet
Dim i As Integer
sFolderName = ThisWorkbook.Path & "\DATA\"
sFileName = Dir$(sFolderName & "時間外*.xls"
Set Sh = Workbooks("表題.xls").Worksheets(1)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Do Until sFileName = ""
Set WB = Workbooks.Open(sFolderName & sFileName)
For i = WB.Worksheets.Count To 1 Step -1
With WB.Worksheets(i)
If IsEmpty(.Range("A5").Value) Or _
.Name = "サンプル" then
.Delete
Else
.Range("A5", .Range("A65536").End(xlUp)) _
.Resize(, 20).Copy Sh.Range("A65536") _
.End(xlUp).Offset(1)
End If
End With
Next i
WB.Close True: Set WB = Nothing
sFileName = Dir$()
Loop
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
Set Sh = Nothing: MsgBox "処理を終了しました", 64
End Sub
で、どうでしょーか ?
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
