Sub gvntw() Dim MyFiles, MyPath, wb As Object MyPath = ThisWorkbook.Path MyFiles = Dir(MyPath & "*.xls")
Application.ScreenUpdating = False Do While MyFiles <> "" If MyFiles <> ThisWorkbook.Name Then Set wb = GetObject(MyPath & "/" & MyFiles) wb.Sheets(1).Range("G6:H38").Copy ThisWorkbook.Activate Range("G6").PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd wb.Sheets(1).Range("C638").Copy ThisWorkbook.Activate Range("C6").PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd wb.Close False End If MyFiles = Dir Loop Application.ScreenUpdating = True End Sub2009-6/200962415255829188.rar