VBA - Open Multiple Workbooks and Copy Sheet to New Workbook

BoLaFish 11:07 pm on December 24, 2009 | Answers: 1    
Tags: copy (26), open (9), sheet (4), vba (7), workbook (3)

Rate Knowledge: (1 votes)

 Loading ...

• BoLaFish 11:07 pm on December 24, 2009
  

  Easily accomplished

  Sub Summarize()

  Dim Counter As Long
  Dim Source As Workbook
  Dim Dest As Workbook

  Const MyDir As String = “c:\temp\”

  Application.ScreenUpdating = False

  For Counter = 1 To 100
  Set Source = Workbooks.Open(MyDir & “Book” & Counter & “.xls”)
  If Counter = 1 Then
  Source.Worksheets(”Sheet1″).Copy
  Set Dest = ActiveWorkbook
  ActiveSheet.Name = Counter
  Else
  Source.Worksheets(”Sheet1″).Copy After:=Dest.Worksheets(Dest.Worksheets.Count)
  Dest.Worksheets(Dest.Worksheets.Count).Name = Counter
  End If
  Source.Close False
  Next

  Dest.SaveAs MyDir & “Summary.xls”

  Application.ScreenUpdating = True

  MsgBox “Done”

  End Sub