Sunday, April 21, 2019

To copy whole sheets to another workbook


To copy whole sheets to another workbook

Sub GetSheets()
Dim path As String
path = Sheets("DO NOT DELETE").Range("e1")
Filename = Dir(path & "*.xls")
  Do While Filename <> ""
  Workbooks.Open Filename:=path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     Sheet.Copy After:=ThisWorkbook.Sheets(1)
  Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
 

End Sub

No comments:

Post a Comment