Hello board,

I have been tasked to do something way beyond my experience with Excel
and I'm requesting your help! Here's the scenario:

A workbook called Projects.xls is in use by many folks. This workbook
has three worksheets, but only two are really necessary to explain.
The first of the two is named Projects, which is hidden. The second is
named Projects (1), which is visible. Projects and Projects (1) are
identical. They consist of data entry fields (normal cells) and
objects like drop down fields and check boxes. Users complete this
form as necessary. There is a button on these two sheets (the users
can only see Projects (1)), that creates another blank Projects
worksheet from the hidden copy. Of course, Excel automatically
increments the name accordingly (Projects (2), Projects (3), etc).
Lastly, there is a hidden row 101 that captures all the data in the
form. The cells in row 101 have either formulas that reference a data
entry field (ex. =A5) or hold the actual value for objects.

We made minor changes to this worksheet, which we are calling
Projects2.xls for now, which includes deleting some check boxes and
replacing them with radio buttons. Pretty much the remaining data
fields and objects are all the same (majority of the worksheet is the
same). When we push this new version out, we want to have a macro or
VB code in place that copies the data from the existing worksheets to
the new worksheets. (The user will be expected to run the macro to
initiate the copy.)

In a nutshell, I need to figure out how to:
1. Copy certain cells and objects from a worksheet in Projects.xls to
the same cells in the same named worksheet in Projects2.xls. I have to
create a loop to make the copy continue through additional worksheets
(users could have only 1 Projects worksheet that has data to copy -
Projects (1) - or they could have hundreds - Projects (1) through
Projects (200)+).
2. After the copy is complete, I would like Projects.xls to close, but
Projects2.xls remains open so that the user can verify the copy prior
to saving. The user can then save on his/her own, delete or rename
Projects.xls to another name, then rename Projects2.xls to
Projects.xls. (It needs to be renamed in the end because it links up
with other workbooks and files.)

I appreciate any and all help. If I've provided too much information,
I'm sorry! If I need to provide further info, please let me know. I'm
eager to learn how to do this!

Thank you!
Tina

I've gotten this far, but as you can see my code is quite manual. If
someone knows how to simplify this code so that I don't have to enter
code for 'n' number of Projects worksheets, it would be greatly
appreciated! I'm also having problems stopping the code. In my
testing, I do not have a Project (3) worksheet, but the code does not
stop, nor does it give me the msgbox.

Sub CopyData()
'
' CopyData Macro
'

' Project (1)

Windows("Projects.xls").Activate
Sheets("Project (1)").Select
Range("A3:X8").Copy
Windows("Projects2.xls").Activate
Range("A3:X8").Select
Sheets("Project (1)").Paste
Windows("Projects.xls").Activate
Sheets("Project (1)").Select
Range("A10:G14").Copy
Windows("Projects2.xls").Activate
Range("A10:G14").Select
Sheets("Project (1)").Paste
Windows("Projects.xls").Activate
Sheets("Project (1)").Select
Range("A16:G16").Copy
Windows("Projects2.xls").Activate
Range("A16:G16").Select
Sheets("Project (1)").Paste
Windows("Projects.xls").Activate
Sheets("Project (1)").Select
Range("H14:X19").Copy
Windows("Projects2.xls").Activate
Range("H14:X19").Select
Sheets("Project (1)").Paste
Windows("Projects.xls").Activate
Sheets("Project (1)").Select
Range("A25:X92").Copy
Windows("Projects2.xls").Activate
Range("A25:X92").Select
Sheets("Project (1)").Paste
Windows("Projects.xls").Activate
Sheets("Project (1)").Select
Range("A101:FY101").Copy
Windows("Projects2.xls").Activate
Range("A101:FY101").Select
Sheets("Project (1)").Paste

Dim wSheet As Worksheet

' Project (2)

Windows("Projects.xls").Activate
On Error Resume Next
Set wSheet = Sheets("Project (2)")

If wSheet Is Nothing Then 'Doesn't Exist
On Error GoTo errH

Else 'Does exist
Windows("Projects2.xls").Activate
Run ("Projects2.xls!McrNewProject")
Windows("Projects.xls").Activate
Sheets("Project (2)").Select
Range("A3:X8").Copy
Windows("Projects2.xls").Activate
Range("A3:X8").Select
Sheets("Project (2)").Paste
Windows("Projects.xls").Activate
Sheets("Project (2)").Select
Range("A10:G14").Copy
Windows("Projects2.xls").Activate
Range("A10:G14").Select
Sheets("Project (2)").Paste
Windows("Projects.xls").Activate
Sheets("Project (2)").Select
Range("A16:G16").Copy
Windows("Projects2.xls").Activate
Range("A16:G16").Select
Sheets("Project (2)").Paste
Windows("Projects.xls").Activate
Sheets("Project (2)").Select
Range("H14:X19").Copy
Windows("Projects2.xls").Activate
Range("H14:X19").Select
Sheets("Project (2)").Paste
Windows("Projects.xls").Activate
Sheets("Project (2)").Select
Range("A25:X92").Copy
Windows("Projects2.xls").Activate
Range("A25:X92").Select
Sheets("Project (2)").Paste
Windows("Projects.xls").Activate
Sheets("Project (2)").Select
Range("A101:FY101").Copy
Windows("Projects2.xls").Activate
Range("A101:FY101").Select
Sheets("Project (2)").Paste

' Project (3)

Windows("Projects.xls").Activate
On Error Resume Next
Set wSheet = Sheets("Project (3)")

If wSheet Is Nothing Then 'Doesn't Exist
On Error GoTo errH

Else 'Does exist
Windows("Projects2.xls").Activate
Range("A3").Select

End If
End If

Exit Sub
errH:
If wSheet Is Nothing Then
MsgBox "Data conversion complete."
End If

End Sub

Dim Bk1 as Workbook Bk2 as Workbook
Dim Sh1 as Worksheet, Sh2 as Worksheet
Dim s as String
Dim ar as Range
Set Bk1 = Workbooks("Projects.xls")
Set Bk2 = Workbooks("Projects2.xls")

s = "A3:X8,A10:G14,A16:G16,H14:X19,A25:X92,A101:FY 101"
for each Sh1 in Bk1.Worksheets
On Error Resume Next
set sh2 = Bk2.Worksheets(sh1.Name)
On Error goto 0
if not sh2 is nothing then
for each ar in sh1.Range(s).Areas
ar.copy Destination:=sh2.Range(ar.Address)
Next
else
' what do you want when the sheet does
' not exist in Project (2)
end if
Next

--
Regards,
Tom Ogilvy



wrote in message
oups.com...
I've gotten this far, but as you can see my code is quite manual. If
someone knows how to simplify this code so that I don't have to enter
code for 'n' number of Projects worksheets, it would be greatly
appreciated! I'm also having problems stopping the code. In my
testing, I do not have a Project (3) worksheet, but the code does not
stop, nor does it give me the msgbox.

Sub CopyData()
'
' CopyData Macro
'

' Project (1)

Windows("Projects.xls").Activate
Sheets("Project (1)").Select
Range("A3:X8").Copy
Windows("Projects2.xls").Activate
Range("A3:X8").Select
Sheets("Project (1)").Paste
Windows("Projects.xls").Activate
Sheets("Project (1)").Select
Range("A10:G14").Copy
Windows("Projects2.xls").Activate
Range("A10:G14").Select
Sheets("Project (1)").Paste
Windows("Projects.xls").Activate
Sheets("Project (1)").Select
Range("A16:G16").Copy
Windows("Projects2.xls").Activate
Range("A16:G16").Select
Sheets("Project (1)").Paste
Windows("Projects.xls").Activate
Sheets("Project (1)").Select
Range("H14:X19").Copy
Windows("Projects2.xls").Activate
Range("H14:X19").Select
Sheets("Project (1)").Paste
Windows("Projects.xls").Activate
Sheets("Project (1)").Select
Range("A25:X92").Copy
Windows("Projects2.xls").Activate
Range("A25:X92").Select
Sheets("Project (1)").Paste
Windows("Projects.xls").Activate
Sheets("Project (1)").Select
Range("A101:FY101").Copy
Windows("Projects2.xls").Activate
Range("A101:FY101").Select
Sheets("Project (1)").Paste

Dim wSheet As Worksheet

' Project (2)

Windows("Projects.xls").Activate
On Error Resume Next
Set wSheet = Sheets("Project (2)")

If wSheet Is Nothing Then 'Doesn't Exist
On Error GoTo errH

Else 'Does exist
Windows("Projects2.xls").Activate
Run ("Projects2.xls!McrNewProject")
Windows("Projects.xls").Activate
Sheets("Project (2)").Select
Range("A3:X8").Copy
Windows("Projects2.xls").Activate
Range("A3:X8").Select
Sheets("Project (2)").Paste
Windows("Projects.xls").Activate
Sheets("Project (2)").Select
Range("A10:G14").Copy
Windows("Projects2.xls").Activate
Range("A10:G14").Select
Sheets("Project (2)").Paste
Windows("Projects.xls").Activate
Sheets("Project (2)").Select
Range("A16:G16").Copy
Windows("Projects2.xls").Activate
Range("A16:G16").Select
Sheets("Project (2)").Paste
Windows("Projects.xls").Activate
Sheets("Project (2)").Select
Range("H14:X19").Copy
Windows("Projects2.xls").Activate
Range("H14:X19").Select
Sheets("Project (2)").Paste
Windows("Projects.xls").Activate
Sheets("Project (2)").Select
Range("A25:X92").Copy
Windows("Projects2.xls").Activate
Range("A25:X92").Select
Sheets("Project (2)").Paste
Windows("Projects.xls").Activate
Sheets("Project (2)").Select
Range("A101:FY101").Copy
Windows("Projects2.xls").Activate
Range("A101:FY101").Select
Sheets("Project (2)").Paste

' Project (3)

Windows("Projects.xls").Activate
On Error Resume Next
Set wSheet = Sheets("Project (3)")

If wSheet Is Nothing Then 'Doesn't Exist
On Error GoTo errH

Else 'Does exist
Windows("Projects2.xls").Activate
Range("A3").Select

End If
End If

Exit Sub
errH:
If wSheet Is Nothing Then
MsgBox "Data conversion complete."
End If

End Sub

Thank you so much! I really appreciate your help!

I pasted the code in my module and replaced the comments with a command
to run a macro we have for generating a new projects worksheet. When I
ran the code, however, it did not copy any further than the Project (1)
worksheet. I did not get any errors or messages; it just stopped. Any
further help would be amazingly appreciated!

Sub CopyData()
'
' CopyData Macro
'

Dim Bk1 As Workbook
Dim Bk2 As Workbook
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim s As String
Dim ar As Range
Set Bk1 = Workbooks("Projects.xls")
Set Bk2 = Workbooks("Projects2.xls")

s = "A3:X8,A10:G14,A16:G16,H14:X19,A25:X92,A101:FY 101"
For Each Sh1 In Bk1.Worksheets
On Error Resume Next
Set Sh2 = Bk2.Worksheets(Sh1.Name)
On Error GoTo 0
If Not Sh2 Is Nothing Then
For Each ar In Sh1.Range(s).Areas
ar.Copy Destination:=Sh2.Range(ar.Address)
Next
Else
Run ("Projects2.xls!McrNewProject")
End If
Next

End Sub

My Best Guess would be: (this assumes that the McrNewProject leaves the
new sheet as the activesheet)

Sub CopyData()
'
' CopyData Macro
'

Dim Bk1 As Workbook
Dim Bk2 As Workbook
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim s As String
Dim ar As Range
Set Bk1 = Workbooks("Projects.xls")
Set Bk2 = Workbooks("Projects2.xls")

s = "A3:X8,A10:G14,A16:G16,H14:X19,A25:X92,A101:FY 101"
For Each Sh1 In Bk1.Worksheets
On Error Resume Next
Set Sh2 = Bk2.Worksheets(Sh1.Name)
On Error GoTo 0
If Not Sh2 Is Nothing Then
For Each ar In Sh1.Range(s).Areas
ar.Copy Destination:=Sh2.Range(ar.Address)
Next
Else
Run "Projects2.xls!McrNewProject"
set Sh2 = Activesheet
Sh2.name = Sh1.Name
For Each ar In Sh1.Range(s).Areas
ar.Copy Destination:=Sh2.Range(ar.Address)
Next

End If
Next

End Sub

--
Regards,
Tom Ogilvy

wrote in message
oups.com...
Thank you so much! I really appreciate your help!

I pasted the code in my module and replaced the comments with a command
to run a macro we have for generating a new projects worksheet. When I
ran the code, however, it did not copy any further than the Project (1)
worksheet. I did not get any errors or messages; it just stopped. Any
further help would be amazingly appreciated!

Sub CopyData()
'
' CopyData Macro
'

Dim Bk1 As Workbook
Dim Bk2 As Workbook
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim s As String
Dim ar As Range
Set Bk1 = Workbooks("Projects.xls")
Set Bk2 = Workbooks("Projects2.xls")

s = "A3:X8,A10:G14,A16:G16,H14:X19,A25:X92,A101:FY 101"
For Each Sh1 In Bk1.Worksheets
On Error Resume Next
Set Sh2 = Bk2.Worksheets(Sh1.Name)
On Error GoTo 0
If Not Sh2 Is Nothing Then
For Each ar In Sh1.Range(s).Areas
ar.Copy Destination:=Sh2.Range(ar.Address)
Next
Else
Run ("Projects2.xls!McrNewProject")
End If
Next

End Sub

Tom,

Thank you so much for your help! Unfortunately, it's not copying
correctly. Project (1) worksheet data is copying correctly from
Projects.xls to Projects2.xls, but then Project (2) worksheet data is
copying from Projects.xls to the Project worksheet (hidden worksheet
only used for generating new worksheets) in Projects2.xls. However, if
I create the appropriate number of worksheets before running the macro
- so that the worksheets in each are the same - then the macro works.
(The code won't run the macro to create a new project as needed along
the way.)

I'll keep poking around, but at minimum we can tell folks to create the
projects first in the new workbook before copying over the data.
Thank you again!
Tina

It if copies to the hidden sheet, it would be because the hidden sheet has
the same name as a sheet in the Project.xls workbook or your macro unhides
it and leaves it as the activesheet.

Since I have no idea what Your routine does, I can only gues and state my
assumptions as I have done.

--
Regards,
Tom Ogilvy




wrote in message
oups.com...
Tom,

Thank you so much for your help! Unfortunately, it's not copying
correctly. Project (1) worksheet data is copying correctly from
Projects.xls to Projects2.xls, but then Project (2) worksheet data is
copying from Projects.xls to the Project worksheet (hidden worksheet
only used for generating new worksheets) in Projects2.xls. However, if
I create the appropriate number of worksheets before running the macro
- so that the worksheets in each are the same - then the macro works.
(The code won't run the macro to create a new project as needed along
the way.)

I'll keep poking around, but at minimum we can tell folks to create the
projects first in the new workbook before copying over the data.
Thank you again!
Tina

Yes, there is a Project worksheet in the Projects.xls workbook, which
is hidden. There is no data in this worksheet, as it is used in the
macro to create new Project worksheets. Projects2.xls is basically a
copy of Projects.xls, with the exception of approximately 6 objects,
which have been deleted or changed from drop downs/checkboxes to option
buttons. Therefore, Projects2.xls also has this hidden worksheet -
Project - which is also empty (no data) because it's used in the macro
to create new Project worksheets. The code is the same as what you
provided last. I've tried some variations, but all resulting the same.

It's not a big deal. We'll just have to have the users run the
mcrNewProject macro in the new workbook prior to running the code to
copy the data. You helped tremendously already!

Thanks!

Sub CopyData()
'
' CopyData Macro
'

Dim Bk1 As Workbook
Dim Bk2 As Workbook
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim s As String
Dim ar As Range
Set Bk1 = Workbooks("Projects.xls")
Set Bk2 = Workbooks("Projects2.xls")

s = "A3:X8,A10:G14,A16:G16,H14:X19,A25:X92,A101:FY 101"
For Each Sh1 In Bk1.Worksheets
if sh1.Visible = xlSheetVisible then
On Error Resume Next
Set Sh2 = Bk2.Worksheets(Sh1.Name)
On Error GoTo 0
If Not Sh2 Is Nothing Then
For Each ar In Sh1.Range(s).Areas
ar.Copy Destination:=Sh2.Range(ar.Address)
Next
Else
Run "Projects2.xls!McrNewProject"
set Sh2 = Activesheet
Sh2.name = Sh1.Name
For Each ar In Sh1.Range(s).Areas
ar.Copy Destination:=Sh2.Range(ar.Address)
Next

End If
End if
Next
End Sub


--
Regards,
Tom Ogilvy


wrote in message
ups.com...
Yes, there is a Project worksheet in the Projects.xls workbook, which
is hidden. There is no data in this worksheet, as it is used in the
macro to create new Project worksheets. Projects2.xls is basically a
copy of Projects.xls, with the exception of approximately 6 objects,
which have been deleted or changed from drop downs/checkboxes to option
buttons. Therefore, Projects2.xls also has this hidden worksheet -
Project - which is also empty (no data) because it's used in the macro
to create new Project worksheets. The code is the same as what you
provided last. I've tried some variations, but all resulting the same.

It's not a big deal. We'll just have to have the users run the
mcrNewProject macro in the new workbook prior to running the code to
copy the data. You helped tremendously already!

Thanks!

Tom,

Thank you for revising the code to help me out! I tried it, and it
improved the issue a bit. It no longer copied the Project (2) data to
the Project worksheet of the new workbook. However, it still didn't
run the macro and create new sheets as necessary. But, guess what? I
was able to manipulate your code to make it work! Here's what ended up
working:

Sub CopyData()
'
' CopyData Macro
'

Dim Bk1 As Workbook
Dim Bk2 As Workbook
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim s As String
Dim ar As Range
Set Bk1 = Workbooks("Projects.xls")
Set Bk2 = Workbooks("Projects2.xls")


s = "A3:X8,A10:G14,A16:G16,H14:X19,A25:X92,A101:FY 101"
For Each Sh1 In Bk1.Worksheets
If Sh1.Visible = xlSheetVisible Then
On Error Resume Next
Set Sh2 = Bk2.Worksheets(Sh1.Name)
Else
Run "Projects2.xls!McrNewProject"
End If
For Each ar In Sh1.Range(s).Areas
Set Sh2 = Bk2.Worksheets(Sh1.Name)
ar.Copy Destination:=Sh2.Range(ar.Address)
Next
Next
End Sub

Tom, I can't thank you enough for your help! This is terrific!
Tina


Tom Ogilvy wrote:
Sub CopyData()
'
' CopyData Macro
'

Dim Bk1 As Workbook
Dim Bk2 As Workbook
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim s As String
Dim ar As Range
Set Bk1 = Workbooks("Projects.xls")
Set Bk2 = Workbooks("Projects2.xls")

s = "A3:X8,A10:G14,A16:G16,H14:X19,A25:X92,A101:FY 101"
For Each Sh1 In Bk1.Worksheets
if sh1.Visible = xlSheetVisible then
On Error Resume Next
Set Sh2 = Bk2.Worksheets(Sh1.Name)
On Error GoTo 0
If Not Sh2 Is Nothing Then
For Each ar In Sh1.Range(s).Areas
ar.Copy Destination:=Sh2.Range(ar.Address)
Next
Else
Run "Projects2.xls!McrNewProject"
set Sh2 = Activesheet
Sh2.name = Sh1.Name
For Each ar In Sh1.Range(s).Areas
ar.Copy Destination:=Sh2.Range(ar.Address)
Next

End If
End if
Next
End Sub


--
Regards,
Tom Ogilvy


wrote in message
ups.com...
Yes, there is a Project worksheet in the Projects.xls workbook, which
is hidden. There is no data in this worksheet, as it is used in the
macro to create new Project worksheets. Projects2.xls is basically a
copy of Projects.xls, with the exception of approximately 6 objects,
which have been deleted or changed from drop downs/checkboxes to option
buttons. Therefore, Projects2.xls also has this hidden worksheet -
Project - which is also empty (no data) because it's used in the macro
to create new Project worksheets. The code is the same as what you
provided last. I've tried some variations, but all resulting the same.

It's not a big deal. We'll just have to have the users run the
mcrNewProject macro in the new workbook prior to running the code to
copy the data. You helped tremendously already!

Thanks!

I would advise you to look very carefully at your results before declaring
that they work.



--
Regards,
Tom Ogilvy

wrote in message
oups.com...
Tom,

Thank you for revising the code to help me out! I tried it, and it
improved the issue a bit. It no longer copied the Project (2) data to
the Project worksheet of the new workbook. However, it still didn't
run the macro and create new sheets as necessary. But, guess what? I
was able to manipulate your code to make it work! Here's what ended up
working:

Sub CopyData()
'
' CopyData Macro
'

Dim Bk1 As Workbook
Dim Bk2 As Workbook
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim s As String
Dim ar As Range
Set Bk1 = Workbooks("Projects.xls")
Set Bk2 = Workbooks("Projects2.xls")


s = "A3:X8,A10:G14,A16:G16,H14:X19,A25:X92,A101:FY 101"
For Each Sh1 In Bk1.Worksheets
If Sh1.Visible = xlSheetVisible Then
On Error Resume Next
Set Sh2 = Bk2.Worksheets(Sh1.Name)
Else
Run "Projects2.xls!McrNewProject"
End If
For Each ar In Sh1.Range(s).Areas
Set Sh2 = Bk2.Worksheets(Sh1.Name)
ar.Copy Destination:=Sh2.Range(ar.Address)
Next
Next
End Sub

Tom, I can't thank you enough for your help! This is terrific!
Tina


Tom Ogilvy wrote:
Sub CopyData()
'
' CopyData Macro
'

Dim Bk1 As Workbook
Dim Bk2 As Workbook
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim s As String
Dim ar As Range
Set Bk1 = Workbooks("Projects.xls")
Set Bk2 = Workbooks("Projects2.xls")

s = "A3:X8,A10:G14,A16:G16,H14:X19,A25:X92,A101:FY 101"
For Each Sh1 In Bk1.Worksheets
if sh1.Visible = xlSheetVisible then
On Error Resume Next
Set Sh2 = Bk2.Worksheets(Sh1.Name)
On Error GoTo 0
If Not Sh2 Is Nothing Then
For Each ar In Sh1.Range(s).Areas
ar.Copy Destination:=Sh2.Range(ar.Address)
Next
Else
Run "Projects2.xls!McrNewProject"
set Sh2 = Activesheet
Sh2.name = Sh1.Name
For Each ar In Sh1.Range(s).Areas
ar.Copy Destination:=Sh2.Range(ar.Address)
Next

End If
End if
Next
End Sub


--
Regards,
Tom Ogilvy


wrote in message
ups.com...
Yes, there is a Project worksheet in the Projects.xls workbook, which
is hidden. There is no data in this worksheet, as it is used in the
macro to create new Project worksheets. Projects2.xls is basically a
copy of Projects.xls, with the exception of approximately 6 objects,
which have been deleted or changed from drop downs/checkboxes to
option
buttons. Therefore, Projects2.xls also has this hidden worksheet -
Project - which is also empty (no data) because it's used in the macro
to create new Project worksheets. The code is the same as what you
provided last. I've tried some variations, but all resulting the
same.

It's not a big deal. We'll just have to have the users run the
mcrNewProject macro in the new workbook prior to running the code to
copy the data. You helped tremendously already!

Thanks!

Hi Tom,

After further testing, problems became apparent. The bad? The code
will run the macro to create a new worksheet, but inconsistently. The
good? The code would copy the correct data from 'n' named sheet in one
workbook to the same 'n' named sheet in the second workbook, just not
for all worksheets if the macro didn't create them as necessary. I
know my results are because I changed the code, but at least the change
started running the macro to create new worksheets, which it was not
doing before. My goal was to try and separate the two actions in the
code. In a sense, first compare the worksheets and ensure there were
the same number of worksheets with the same name; if not, run the macro
to generate new worksheets. Secondly, go back and copy data from one
worksheet to same named worksheet in new workbook.

Well, we're running out of time, so we have to change direction.

Again, thanks for all your help. It's a shame we couldn't get this to
work! :O(
Tina