Help combining worksheets into a workbook

N

No

I have a template that I use to create a weekly business report, normally
what I do is open the template fill in the data then "save as" (date is the
name) The other day I was thinking there has to be a way to have one
workbook that has all of the weekly reports in one book, here is my
question.

1. How can I take all of the excel documents and put them into a workbook so
that each weekly report will be a worksheet in that work book.
2. Once I get this done how can I open the template and then save that
report as a worksheet within the workbook, this question is for future
reports not ones I already have done. I would assume the template would just
be one of the worksheets in the workbook right? after I save the worksheet
using the template I want the template to remain blank for the next time.

I appreciate any and all help and as you can tell by my questions I am not
that experienced with excel so I would appreciate any suggestions to be as
detailed as possible.

Thanks again
 
R

Ron de Bruin

Try this for :1
http://www.rondebruin.nl/copy3.htm#sheet

for 2 :
You can make a copy of your template worksheet like this if
it is in the same workbook

Sub test()
Worksheets("template").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Format(Now, "dd-mm-yy h-mm-ss")
End Sub
 
N

No

Thanks for your help Ron,

Like I siad I have very little experience in Excel, I have never worked
with code or macros at all.

I did look at your link and from what I can see it talks about placing all
the workbooks into a folder named "data" in my case it is located G:\data
then open a new workbook and run the code in that workbook. if I understand
this right the code will take the first sheet of each workbook in the
G:\data folder and make them a worksheet in the new workbook ?

If so that is perfect for me because all of the workbooks I have saved are
only 1 page and I want to combine them as worksheets into one workbook.

I just have never run code in Excel, can you suggest a tutorial on how this
is done?

Thanks again
 
R

Ron de Bruin

I just have never run code in Excel, can you suggest a tutorial on how this
is done?
Click to expand...

Sure , no problem

Open a new workbook

Alt-F11 (to open the VBA editor)
Insert module from the menubar in the VBA editor
Paste the macro TestFile3 in there
Alt-Q to go back to Excel

In Excel press Alt-F8 to get a macro list
Select it and press Run


Sub TestFile3()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String SaveDriveDir = CurDir
MyPath = "G:\Data"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
mybook.Worksheets(1).Copy after:= _
basebook.Sheets(basebook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0
' You can use this if you want to copy only the values
' With ActiveSheet.UsedRange
' .Value = .Value
' End With
mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
 
R

Ron de Bruin

Watch out for line wrap
Take this one

Sub TestFile3()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
SaveDriveDir = CurDir
MyPath = "G:\Data"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
mybook.Worksheets(1).Copy after:= _
basebook.Sheets(basebook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0
' You can use this if you want to copy only the values
' With ActiveSheet.UsedRange
' .Value = .Value
' End With
mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
 
N

No

Ron,

Thanks alot this worked perfect and now all my workbooks are in one
workbook as worksheets just as I wanted. Just one more question to clearify
something.

One of the workbooks that is now a worksheet is the template that I fill
out, in the past I would save it as whatever date it was and then when I
closed the workbook and it asked if I wanted to save changes I would say no
so that next time it was still a blank template. How would I do that now
that they are all in the same workbook.

Thanks so much for your help....
 
R

Ron de Bruin

Hi No

One way

Give the blank template the name "template"
This example will make a copy of that sheet and name it as the date/time
You work in this worksheet so the template stay empty

Sub test()
Worksheets("template").Copy After:=Sheets(Sheets.Count)
' change the format as you want (you can't use / in a sheet name)
ActiveSheet.Name = Format(Now, "dd-mm-yy h-mm-ss")
End Sub

Every time you need a new worksheet you run this macro
Post back if you need something else
 
R

raehippychick

Hi

I am still very much a begginer here with these macros - I have bee
helped with my first one that now works great.

Now I need something to copy a bunch of worksheets into one file and
did a search and found this thread as it seems pretty much what I a
looking for. I followed the instructions and updated the line:

MyPath = "G:\Data" with my own path

Unfortunately when I go to run it, it all falls over at this point...

mybook.Worksheets(1).Copy after:= _
basebook.Sheets(basebook.Sheets.count)

These two lines come up yellow and the debugger says Run time erro
"1004":
Copy method of Worksheet class failed

Please could anyone help me as to what I have done wrong? I copied th
code below directly into a new module as instructed and used the secon
posting with no line wraps to copy from

The workbooks I need to copy into worksheets in the 'master' hav
password to open on them make a problem?

Very many thanks

Rae
 
R

raehippychick

Ron said:
*Hi

http://www.rondebruin.nl/copy3.htm#sheet
If the workbook is protected it will ask you for a password
What Excel version do you use?

--
Regards Ron de Bruin
http://www.rondebruin.nl


*
Click to expand...

Hi - I am using Excel 97 and yes the books I am pulling in are passwor
protected. This is not much of a problem if the user types the passwor
in correctly - but if they mistype one the whole thing falls over an
up pops the VB error message!

Fine for me - but for the users a bit confusing! Is there anyone wh
could help me add in some code that offers two options if the passwor
is entered incorrectly please? :-

1) Gives an option to cancel and abort out of the macro completel
returning the user to where they were with no sheets added

2) gives the user another chance to enter the password

(preferably so both come up in one error box pop-up thingy if poss)

My code so far:


Sub Add_Sheets_From_Heads()
Dim UInput As String
Dim Msg As String

Msg = "Have you deleted the old sheets? If not press cancel and go an
do it now!"
Msg = Msg & vbNewLine
Msg = Msg & vbNewLine
Msg = Msg & "If you have deleted the Heads sheets enter a Y into th
box and press OK"

Do
UInput = Application.InputBox(Msg)
If UInput = False Then Exit Sub
If UInput = "Y" Then
MsgBox "Thank You"
Exit Do
End If
Loop

Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
SaveDriveDir = CurDir
MyPath = "D:\Master\Data"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
mybook.Worksheets(1).Copy after:= _
basebook.Sheets(basebook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0
' You can use this if you want to copy only the values
' With ActiveSheet.UsedRange
' .Value = .Value
' End With
mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Su
 
R

raehippychick

Ron said:
*Hi raehippychick (nice name)

Is it the same password for all files?

--
Regards Ron de Bruin
http://www.rondebruin.nl

*
Click to expand...

Hi

No it has to be different one for each file sadly because each files
belongs to a different head of department and they mustn't see each
others! - is that going to make life difficult?

Rae
 
R

Ron de Bruin

Hi Rae

Here is a small example that give you some ideas

Sub test()
Do
On Error Resume Next
Workbooks.Open ("C:\Data\test.xls")
If Err.Number = 0 Then
Exit Do
End If
Err.Clear
On Error GoTo 0
Loop
End Sub
 
Top