View Full Version : Solved: How can I copy sheet 1 from multiple spreadsheets to one new workbook?
marshybid
12-09-2008, 03:07 AM
Hi All,
I have c. 200 spreadsheets in a folder, I need to quickly copy sheet 1 of each of these and paste them into one workbook. I would also like to name each sheet in the new workbook as the last 9 characters of the original filename.
Can anyway help with an easy way to do this.
Thanks,
Marshybid
Bob Phillips
12-09-2008, 03:56 AM
Sub LoopFiles()
Dim FSO As Object
Dim Folder As Object
Dim file As Object
Dim wb As Workbook
Dim wbNew As Workbook
Set wbNew = Workbooks.Add
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder("c:\Test")
For Each file In Folder.Files
If file.Type Like "Microsoft*Excel*Worksheet*" Then
Set wb = Workbooks.Open(Filename:=file.Path)
wb.Worksheets(1).Copy after:=wbNew.Worksheets(wbNew.Worksheets.Count)
wbNew.Worksheets(wbNew.Worksheets.Count).Name = Left$(wb.Name, 9)
wb.Close savechanges:=False
End If
Next file
Application.DisplayAlerts = False
wbNew.Worksheets(3).Delete
wbNew.Worksheets(2).Delete
wbNew.Worksheets(1).Delete
Application.DisplayAlerts = True
Set wb = Nothing
Set wbNew = Nothing
Set file = Nothing
Set Folder = Nothing
Set FSO = Nothing
End Sub
marshybid
12-09-2008, 04:31 AM
Thanks Bob, that worked a treat and aved me about 3 hours of manula copy and paste.
Marking as solved.
Marshybid :hi:
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.