Macro to copy worksheets

[Moogie]

Greetings Excel Gurus,
Thank you very much for previous help.
I need a macro. I have 31 excel workbook files with different filenames and
with a varying number of worksheets in each. I need to copy all sheets
in the 31 files (except last two in each workbook) into one master workbook.
Please help
Thanks in advance

 

[Richie(UK)]

Hi Moogie,

See if you can use something along the following lines:

<pre>
Sub SheetstoNewBook()
'copy 31 excel files to one new workbook (this one!)
'exclude last 2 sheets from each workbook
Dim TheDir As String, vaFileName As Variant

TheDir = ThisWorkbook.Path
'don't know your intended directory,
'therefore save thisworkbook in target directory

Application.ScreenUpdating = False

With Application.FileSearch
.NewSearch
.LookIn = TheDir
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For Each vaFileName In .FoundFiles
If vaFileName <> TheDir & "" & ThisWorkbook.Name Then
'only try to open workbooks other than this one
Workbooks.Open (vaFileName)
CopySheets
'go to copy sheets routine
Application.DisplayAlerts = False
'avoid warning message when copied workbook is closed
ActiveWorkbook.Close
Application.DisplayAlerts = True
End If
Next
End If
End With

Application.ScreenUpdating = True

End Sub

Sub CopySheets()
Dim newsheet As Worksheet, j As Integer, Last As Integer

Last = 0
For j = ActiveWorkbook.Sheets.Count To 1 Step -1
Last = Last + 1
If Last > 2 Then
ActiveWorkbook.Worksheets(j).UsedRange.Copy
Set newsheet = ThisWorkbook.Sheets.Add
'add sheet to copy to
newsheet.Range("A1").PasteSpecial
Application.CutCopyMode = False 'clear the clipboard
End If
Next j

End Sub

</pre>

HTH

 

[Moogie]

Thanks so much Richie, I will give this a try when I get to work tomorrow. Just one thing, the 31 files I have are all passworded and I already have a macro that opens all of them so I don't have to enter the passwords for all of them. Can I integrate that into this macro?

 

[Moogie]

Greetings, I am having a couple problems with this macro. One, it is copying all worksheets from the files instead of all but the last two sheets in each file. And, when it copies the files it is not retaining the worksheet name. Any help is greatly apprecitated. Thanks

 

[Richie(UK)]

Hi Moogie,

I think you can only copy/move whole worksheets within the same workbook, thats why I went with the approach of copying the used range for each worksheet, and thats why the worksheet name isn't copied across. However, you could modify the code to assign to a variable the worksheet name of each sheet being copied then use this to rename the new sheet being created.

As for the copying all sheets part, are you sure? I tested it and it didn't copy the last two sheets on my workbooks.

 

[Moogie]

Greetings Richie,
First I would like to thank you for all your help so far. I really apreciate it.
I was hoping to be able to copy the worksheets with their worksheet name. I am constantly changing these files, adding and naming sheets. Right now I am printing out each files sheets workbook by workbook, then I have to put about 500 papers in alphabetical order. I wanted to be able to copy them to another workbook, alphabetize them, then print them out to save myself alot of time. I have a macro that opens all of the passworded files and I also have a macro that will alphabetize the worksheets in the workbook. One missing piece is copying the worksheets(except last two files from each) from the files with their worksheet names.
Thanks again