PDA

View Full Version : Solved: copy first sheets from all work books in a file into a collective sheet



pir81
07-27-2011, 01:41 PM
Hello,

I would like to have a workbook (that already includes two spreadsheets that must not be changed) into which all first spreadsheets from all workbooks (xls and xlsx if possible) in a folder are copied exactly as they are (formating, numbers, text ...; don't need full formulars though, values are enough). And the new spreadsheets should be called same as the file names in the folder (without .xls obviousy).

I found the following code and tried playing with it. It "works" with the absolute path, but not relative (I am probably doing something wrong). But it strangely copies the master workbook itself and not the sheets from the other files.

Could please someone help me?


Sub Combine()


Fpath = "C:\temp\" ' change to suit your directory
Fname = Dir(FilePth & "*.xls")

Do While Fname <> ""
Workbooks.Open Fpath & Fname
Sheets(1).Copy After:=Workbooks("Master.xlsm").Sheets(Workbooks("Master.xlsm").Sheets.Count)
Workbooks(Fname).Close SaveChanges:=False
Fname = Dir
Loop

End Sub


Thank you very much!

CatDaddy
07-27-2011, 03:09 PM
what is FilePth?

CatDaddy
07-27-2011, 03:11 PM
if you open all of the workbooks to be copied you could do something like:

Dim wb as Workbook

For each wb is Application.Workbooks
Sheets(1).Copy After:=Workbooks("Master.xlsm").Sheets(Workbooks("Master.xlsm").Sheets.Count)
next wb

pir81
07-27-2011, 03:35 PM
if you open all of the workbooks to be copied you could do something like:


I don't want to open all the workbooks :(

Fpath is a constant I would guess, but I have seen VBA on Sunday for the first time, so no guarantee :D

Kenneth Hobs
07-27-2011, 04:12 PM
Tip: Always use as the first line in your Module:
Option Explicit

Change?
Fpath = "C:\temp\" ' change to suit your directory Fname = Dir(FilePth & "*.xls")
To:
Fpath = "C:\temp\" ' change to suit your directory Fname = Dir(FPath & "*.xls")

If master is the workbook with the code, you can use ThisWorkbook rather than Workbooks("Master.xls").

pir81
07-27-2011, 11:49 PM
Tip: Always use as the first line in your Module:
Option Explicit
Change?
Fpath = "C:\temp\" ' change to suit your directory Fname = Dir(FilePth & "*.xls") To:
Fpath = "C:\temp\" ' change to suit your directory Fname = Dir(FPath & "*.xls")
If master is the workbook with the code, you can use ThisWorkbook rather than Workbooks("Master.xls").

Option Explicit throws an invalide inside procedure

what is the difference between my original line and your change suggestion. Sorry I don't see it.

pir81
07-27-2011, 11:52 PM
Tried working on it further and nothing works anymore :(

I changed as suggested the "Master.xlsm" to ThisWorkbook to make it better readable. But I am not sure, why it is not working. There are files in C:\temp, they are .xls and they have worksheets.

Please help.


Sub Combine()

Fpath = "C:\temp\" ' change to suit your directory
Fname = Dir(FilePth & "*.xls")

Do While Fname <> ""
Workbooks.Open Fpath & Fname
Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Workbooks(Fname).Close SaveChanges:=False
Fname = Dir
Loop

End Sub

Kenneth Hobs
07-28-2011, 05:14 AM
When using Option Explicit, you are required to Dim all variables. It is obvious that your FilePth has no value. You could use F8 to debug and step through the code to see that.

Sub Combine()
Dim Fpath as String
Fpath = "C:\temp\" ' change to suit your directory
Fname = Dir(Fpath & "*.xls")
Do While Fname <> ""
Workbooks.Open Fpath & Fname
Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Workbooks(Fname).Close SaveChanges:=False Fname = Dir
Loop
End Sub

pir81
07-28-2011, 05:34 AM
Kenneth,

it works!

I also added a line for renaming the sheets, which seems to work as well, but it still only copies the first sheet from the master and not the sheets from the different workbooks. How come?

Sub Combine()
Dim Fpath As String

Fpath = "C:\temp\" ' change to suit your directory
Sheets("Sheet1").Range("D5").Formula = "=" & Fpath
Fname = Dir(Fpath & "*.xls")
Sheets("Sheet1").Range("D6").Formula = "=" & Fname

Do While Fname <> ""
Workbooks.Open Fpath & Fname
Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Fname 'this calls the sheet same as the file
Workbooks(Fname).Close SaveChanges:=False
Fname = Dir
Loop

End Sub

Kenneth Hobs
07-28-2011, 05:51 AM
Copies the master sheet? It copies the slave sheet to the master workbook.

Here is how to interate the slave workbook's worksheets. I think that it will add a number to the added sheet after the first one since you wanted to rename it. That might be best for you anyway. I would suggest that you strip the file extension from the fname for sheet names though.

Sub Combine()
Dim Fpath As String
Dim ws As Worksheet

Fpath = "C:\temp\" ' change to suit your directory
Sheets("Sheet1").Range("D5").Formula = "=" & Fpath
Fname = Dir(Fpath & "*.xls")
Sheets("Sheet1").Range("D6").Formula = "=" & Fname

Do While Fname <> ""
Workbooks.Open Fpath & Fname
For Each ws In ActiveWorkbook.Worksheets
ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Fname 'this calls the sheet same as the file
Workbooks(Fname).Close SaveChanges:=False
Next ws
Fname = Dir
Loop
End Sub

pir81
07-28-2011, 07:26 AM
I am getting reeeeaally confused...

I want only the first sheet from each slave, thus I took the "for each" look out again.

Issues:
for 10 sheets it names them by the file name, for the last two by the original work sheet name


Any further sugesstions?

Sub getOtherWorkbooks()
Dim Fpath As String

Fpath = ThisWorkbook.Path & "\MUs\" ' change to suit your directory
Fname = Dir(Fpath & "*.xlsx")

Do While Fname <> ""
Workbooks.Open Fpath & Fname
ActiveWorkbook.Worksheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'this should take the slaves
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Fname 'this calls the sheet same as the file
Workbooks(Fname).Close SaveChanges:=False
Fname = Dir
Loop
End Sub

pir81
07-28-2011, 07:47 AM
Found the culprit. Someone has hidden a file in the source files and that seems to throw VBA off (well, at list in the way I coded it)

Kenneth Hobs
07-28-2011, 07:48 AM
If a workbook is already open, it will not open it again. You told it to find xlsx files. Are you sure the count is right and you did not count xls files?

You can put a debug.print or msgbox to see what files are being found or look at your sheet names added I guess.

Here is one of my examples that checks for the found files that are not open and not the master workbook.
Sub DirFiles()
Dim FileName As String, FileSpec As String, FileFolder As String
Dim wb As Workbook

FileFolder = ThisWorkbook.Path & "\"
FileSpec = FileFolder & "*.xls*"

FileName = Dir(FileSpec)
If FileName = "" Then Exit Sub

' Loop until no more matching files are found
Do While FileName <> ""
If IsWorkbookOpen(FileName) = False Then
MsgBox FileName
'Set wb = Workbooks.Add(FileFolder & FileName)
DoEvents
'wb.Close True
End If
FileName = Dir()
Loop

End Sub

Function IsWorkbookOpen(stName As String) As Boolean
Dim Wkb As Workbook
On Error Resume Next ' In Case it isn't Open
Set Wkb = Workbooks(stName)
If Not Wkb Is Nothing Then IsWorkbookOpen = True
'Boolean Function assumed To be False unless Set To True
End Function

pir81
07-28-2011, 08:05 AM
thank you so much Kenneth.
One more question then. How do I copy only values and not the formulars (I need to forward the final master file without all the slave workbooks).

Kenneth Hobs
07-28-2011, 08:44 AM
Sub getOtherWorkbooks()
Dim Fpath As String

Fpath = ThisWorkbook.Path & "\MUs\" ' change to suit your directory
Fname = Dir(Fpath & "*.xlsx")

Do While Fname <> ""
Workbooks.Open Fpath & Fname
ActiveWorkbook.Worksheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'this should take the slaves
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Fname 'this calls the sheet same as the file
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Value = _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Value
Workbooks(Fname).Close SaveChanges:=False
Fname = Dir
Loop
End Sub

pir81
07-28-2011, 09:31 AM
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Value = _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Value



This throws an error for me. Do you know why?


Also is there a way to have a my code check on all the files first, see if there are any hiden sheets, and if so throw a prompt OK box and quit the macro before startig copying...

Could also be a separate macro. could it work similar to the above (see below)?

Sub getOtherWorkbooks()
Dim Fpath As String

Fpath = ThisWorkbook.Path & "\MUs\" ' change to suit your directory
Fname = Dir(Fpath & "*.xlsx")

Do While Fname <> ""
Workbooks.Open Fpath & Fname
'if hiden add to a string
Workbooks(Fname).Close SaveChanges:=False
Fname = Dir
Loop
'if string is not NULL prompt (or prompt anyhow)
End Sub

Kenneth Hobs
07-28-2011, 10:13 AM
Use this:
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).usedrange.Value = _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).usedrange.Value

pir81
07-29-2011, 12:10 AM
Use this:
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).usedrange.Value = _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).usedrange.Value

A little thank you in between for your ongoing help Kenneth.

The above works well unless someone protected the workbook/sheet. Then it crashes. Is there anyway around that?

Kenneth Hobs
07-29-2011, 05:05 AM
If you know the passwords, sure that is easily done.

pir81
07-29-2011, 05:42 AM
If you know the passwords, sure that is easily done.

And if I don't? It copied the formulars from the locked sheets, so why can't it just get the values?

Kenneth Hobs
07-29-2011, 11:09 AM
If all you need are the values, you can do that with the workbooks closed which works more quickly and can bypass some password issues. There are two methods shown in: http://www.vbaexpress.com/forum/showthread.php?t=38424

If you do the link referencing method, the values may show 0 where they were just empty in the slave workbook. Use the .Value = .Value method to convert the linked formulas to a static value.

Bradley123
07-30-2011, 04:51 AM
Thanks for the great great information link.i am very pleased to find out your post.

pir81
08-02-2011, 04:44 AM
Kenneth, thank you so much for your valuable help!