Import/Copy some data from one workbook to a similar workbook

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:FY101"
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



<dmbluv@comcast.net> wrote in message
news:1141588543.956145.241020@e56g2000cwe.googlegroups.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:FY101"
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:FY101"
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

<dmbluv@comcast.net> wrote in message
news:1141591637.691638.138450@e56g2000cwe.googlegroups.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:FY101"
> 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