|
▼よっちゃん さん:
ごめんなさい。今日はもう返事できません。
Private Sub CommandButton1_Click()
Dim ブック As Worknook
Dim フォルダ As String
Dim buf As String
'画面更新の停止
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'自動再計算の中止
Application.Calculation = xlCalculationManual
'シートの削除
Range("A6:Z65536").Clear
フォルダ = Range("A2").Value & "\"
'データ集約
buf = Dir(フォルダ & "*.xlsx")
Do While buf <> ""
Set ブック = Workbooks.Open(フォルダ & buf)
Range("A65536").End(xlUp).Offset(1, 0).Value = buf
ブック.Sheets("入力用").Range("C73:Q102").Copy Range("A65536").End(xlUp).Offset(1, 0)
ブック.Close SaveChanges:=False
buf = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
|
|