ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   copyingsheets between workbooks with same name (https://www.excelbanter.com/excel-programming/349305-copyingsheets-between-workbooks-same-name.html)

Kbob

copyingsheets between workbooks with same name
 
Ok, I think this may be a complicated one.

I have two workbooks lets call one A the other B

in A I have 30 sheets and in B I have 10 sheets.
I want to create a form box that will allow the user to first Browse for
Sheet
B (or any workbook name) and then when clicking OK the macro will copy the
data from any sheet in workbook B that has the same sheet name in workbook A.
This could be only five of those sheets. Keep in mind they number of sheets
in each workbook could be more that 5 or 10 and that the sheet names are not
the same each time (although some, the ones I want to copy from B to A would
have the same name)
Make sense.
Thanks and Happy New Year

Dave Peterson

copyingsheets between workbooks with same name
 
There's lots of ways you can copy data from one sheet to another. You could
dump all the existing data and replace it with the new stuff--or you could merge
it at the bottom.

This routine merges it at the bottom--but you can change it to do what you want:

Option Explicit
Sub testme01()

Dim wkbk1 As Workbook
Dim wkbk2 As Workbook
Dim wks As Worksheet
Dim DestCell As Range
Dim myActiveWindowState As Long

myActiveWindowState = ActiveWindow.WindowState
'nice for clicking on
Windows.Arrange ArrangeStyle:=xlTiled

Set wkbk1 = Nothing
On Error Resume Next
Set wkbk1 = Application.InputBox _
(Prompt:="Click a cell in the SENDING workbook", Type:=8).Parent.Parent
On Error GoTo 0

If wkbk1 Is Nothing Then
GoTo ExitNow:
End If

Set wkbk2 = Nothing
On Error Resume Next
Set wkbk2 = Application.InputBox _
(Prompt:="Click a cell in the RECEIVING workbook", Type:=8).Parent.Parent
On Error GoTo 0

If wkbk2 Is Nothing Then
GoTo ExitNow:
End If

If wkbk2.FullName = wkbk1.FullName Then
MsgBox "Please choose two DIFFERENT workbooks!"
GoTo ExitNow:
End If

For Each wks In wkbk1.Worksheets
With wks
If WorksheetExists(.Name, wkbk2) Then
With wkbk2.Worksheets(.Name)
Set DestCell = .Range("a" _
& .Cells.SpecialCells(xlCellTypeLastCell).Row + 1)
End With
.Range("a1", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _
Destination:=DestCell
End If
End With
Next wks

ExitNow:
ActiveWindow.WindowState = myActiveWindowState

End Sub
Function WorksheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) 0)
End Function



Kbob wrote:

Ok, I think this may be a complicated one.

I have two workbooks lets call one A the other B

in A I have 30 sheets and in B I have 10 sheets.
I want to create a form box that will allow the user to first Browse for
Sheet
B (or any workbook name) and then when clicking OK the macro will copy the
data from any sheet in workbook B that has the same sheet name in workbook A.
This could be only five of those sheets. Keep in mind they number of sheets
in each workbook could be more that 5 or 10 and that the sheet names are not
the same each time (although some, the ones I want to copy from B to A would
have the same name)
Make sense.
Thanks and Happy New Year


--

Dave Peterson

Kbob

copyingsheets between workbooks with same name
 
Dave
thanks for the quick reply. I will look this over. It seems that the user
has to click on the independent (sendin) worksheet.
I wanted to be able to automate the entire process so that the user would
only have to tell the dependent (receiving ) workbook its name. the macro
would then search all sheets for those with the same names as the recieivng
sheets and copy those in.

"Dave Peterson" wrote:

There's lots of ways you can copy data from one sheet to another. You could
dump all the existing data and replace it with the new stuff--or you could merge
it at the bottom.

This routine merges it at the bottom--but you can change it to do what you want:

Option Explicit
Sub testme01()

Dim wkbk1 As Workbook
Dim wkbk2 As Workbook
Dim wks As Worksheet
Dim DestCell As Range
Dim myActiveWindowState As Long

myActiveWindowState = ActiveWindow.WindowState
'nice for clicking on
Windows.Arrange ArrangeStyle:=xlTiled

Set wkbk1 = Nothing
On Error Resume Next
Set wkbk1 = Application.InputBox _
(Prompt:="Click a cell in the SENDING workbook", Type:=8).Parent.Parent
On Error GoTo 0

If wkbk1 Is Nothing Then
GoTo ExitNow:
End If

Set wkbk2 = Nothing
On Error Resume Next
Set wkbk2 = Application.InputBox _
(Prompt:="Click a cell in the RECEIVING workbook", Type:=8).Parent.Parent
On Error GoTo 0

If wkbk2 Is Nothing Then
GoTo ExitNow:
End If

If wkbk2.FullName = wkbk1.FullName Then
MsgBox "Please choose two DIFFERENT workbooks!"
GoTo ExitNow:
End If

For Each wks In wkbk1.Worksheets
With wks
If WorksheetExists(.Name, wkbk2) Then
With wkbk2.Worksheets(.Name)
Set DestCell = .Range("a" _
& .Cells.SpecialCells(xlCellTypeLastCell).Row + 1)
End With
.Range("a1", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _
Destination:=DestCell
End If
End With
Next wks

ExitNow:
ActiveWindow.WindowState = myActiveWindowState

End Sub
Function WorksheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) 0)
End Function



Kbob wrote:

Ok, I think this may be a complicated one.

I have two workbooks lets call one A the other B

in A I have 30 sheets and in B I have 10 sheets.
I want to create a form box that will allow the user to first Browse for
Sheet
B (or any workbook name) and then when clicking OK the macro will copy the
data from any sheet in workbook B that has the same sheet name in workbook A.
This could be only five of those sheets. Keep in mind they number of sheets
in each workbook could be more that 5 or 10 and that the sheet names are not
the same each time (although some, the ones I want to copy from B to A would
have the same name)
Make sense.
Thanks and Happy New Year


--

Dave Peterson


Dave Peterson

copyingsheets between workbooks with same name
 
This section gets the sending workbook:

Set wkbk1 = Nothing
On Error Resume Next
Set wkbk1 = Application.InputBox _
(Prompt:="Click a cell in the SENDING workbook", Type:=8).Parent.Parent
On Error GoTo 0

If wkbk1 Is Nothing Then
GoTo ExitNow:
End If

You can replace it with this line:

Set wkbk1 = workbooks("Yourworkbooknamehere.xls")

Yourworkbooknamehere.xls will need to be already open.

Kbob wrote:

Dave
thanks for the quick reply. I will look this over. It seems that the user
has to click on the independent (sendin) worksheet.
I wanted to be able to automate the entire process so that the user would
only have to tell the dependent (receiving ) workbook its name. the macro
would then search all sheets for those with the same names as the recieivng
sheets and copy those in.

"Dave Peterson" wrote:

There's lots of ways you can copy data from one sheet to another. You could
dump all the existing data and replace it with the new stuff--or you could merge
it at the bottom.

This routine merges it at the bottom--but you can change it to do what you want:

Option Explicit
Sub testme01()

Dim wkbk1 As Workbook
Dim wkbk2 As Workbook
Dim wks As Worksheet
Dim DestCell As Range
Dim myActiveWindowState As Long

myActiveWindowState = ActiveWindow.WindowState
'nice for clicking on
Windows.Arrange ArrangeStyle:=xlTiled

Set wkbk1 = Nothing
On Error Resume Next
Set wkbk1 = Application.InputBox _
(Prompt:="Click a cell in the SENDING workbook", Type:=8).Parent.Parent
On Error GoTo 0

If wkbk1 Is Nothing Then
GoTo ExitNow:
End If

Set wkbk2 = Nothing
On Error Resume Next
Set wkbk2 = Application.InputBox _
(Prompt:="Click a cell in the RECEIVING workbook", Type:=8).Parent.Parent
On Error GoTo 0

If wkbk2 Is Nothing Then
GoTo ExitNow:
End If

If wkbk2.FullName = wkbk1.FullName Then
MsgBox "Please choose two DIFFERENT workbooks!"
GoTo ExitNow:
End If

For Each wks In wkbk1.Worksheets
With wks
If WorksheetExists(.Name, wkbk2) Then
With wkbk2.Worksheets(.Name)
Set DestCell = .Range("a" _
& .Cells.SpecialCells(xlCellTypeLastCell).Row + 1)
End With
.Range("a1", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _
Destination:=DestCell
End If
End With
Next wks

ExitNow:
ActiveWindow.WindowState = myActiveWindowState

End Sub
Function WorksheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) 0)
End Function



Kbob wrote:

Ok, I think this may be a complicated one.

I have two workbooks lets call one A the other B

in A I have 30 sheets and in B I have 10 sheets.
I want to create a form box that will allow the user to first Browse for
Sheet
B (or any workbook name) and then when clicking OK the macro will copy the
data from any sheet in workbook B that has the same sheet name in workbook A.
This could be only five of those sheets. Keep in mind they number of sheets
in each workbook could be more that 5 or 10 and that the sheet names are not
the same each time (although some, the ones I want to copy from B to A would
have the same name)
Make sense.
Thanks and Happy New Year


--

Dave Peterson


--

Dave Peterson


All times are GMT +1. The time now is 01:50 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com