Hello
I modified John Walkenbach’s CopyMultipleSelection to copy multiple
areas from each worksheet in workbook AA to worksheet in workbook BB.
All the sheets in BB will have the same name as those in AA. Example:
Copy selected areas in worksheet “LA” in workbook AA to similarly
named worksheet “LA” in workbook BB.


Here are the modified codes. It errors out on the line
SelAreas(i).Copy pasteRange.Offset(RowOffset, ColOffset).
I would appreciate someone pointing me in the right direction.


Sub CopyMultipleSelection()
'This code is in a module in workbook BB

Dim qq As Integer: Dim tt As Integer
Dim BB As Workbook: Set BB = ThisWorkbook
Dim rAcells As Range:
Dim SelAreas() As Range: Dim PasteRange As Range:
Dim UpperLeft As Range: Dim NumAreas As Integer, i As Integer
Dim TopRow As Long, LeftCol As Integer: Dim RowOffset As Long,
ColOffset As Integer

Application.Calculation = xlCalculationManual

qq = 0
For tt = 1 To Workbooks.Count
If Windows(Workbooks(tt).Name).Visible = True Then
qq = qq + 1
If BB.Name < Workbooks(tt).Name Then
Windows(Workbooks(tt).Name).Activate
Range("F11").Value = BB.Name ' In workbook AA, set name of
workbook BB
End If
End If
Next tt
If qq = 1 Then GoTo WarningMessage
If qq 2 Then GoTo WarningMessage2

If BB.Name < Range("F11").Value Then
Windows(Range("F11").Value).Activate 'activate workbook AA
Set rAcells = ActiveSheet.Range("E15:CI86")
Dim rNumTextcells As Range:
On Error Resume Next: Set rNumTextcells =
rAcells.SpecialCells(xlCellTypeConstants) 'select areas in AA to
copy to workbook BB

ActiveSheet.Range("F10") = ActiveSheet.Name 'name of worksheet in AA

rNumTextcells.Select: 'areas selected to copy to worksheet in BB

' Store the areas as separate Range objects
NumAreas = Selection.Areas.Count
ReDim SelAreas(1 To NumAreas)
For i = 1 To NumAreas
Set SelAreas(i) = Selection.Areas(i)
Next

' Determine the upper left cell in the multiple selection
TopRow = ActiveSheet.Rows.Count
LeftCol = ActiveSheet.Columns.Count

For i = 1 To NumAreas
If SelAreas(i).Row < TopRow Then TopRow = SelAreas(i).Row
If SelAreas(i).Column < LeftCol Then LeftCol =
SelAreas(i).Column
Next
Set UpperLeft = Cells(TopRow, LeftCol)

On Error Resume Next

On Error GoTo 0

' Make sure only the upper left cell is used
Set PasteRange = UpperLeft.Range("A1")
Set PasteRange =
Workbooks(Range("F11").Value).Worksheets(Range("F1 0").Value).Range(PasteRange.Address)
'determine the upper left cell in workbook BB

For i = 1 To NumAreas
RowOffset = SelAreas(i).Row - TopRow
ColOffset = SelAreas(i).Column - LeftCol
SelAreas(i).Copy PasteRange.Offset(RowOffset, ColOffset)
Next i

Range("F11").ClearContents: Range("F10").ClearContents
Application.Calculation = xlCalculationAutomatic
Exit Sub

WarningMessage:
MsgBox ("Only 1 worksbook in windows - you need 2 workbooks to run
this macro")
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub

WarningMessage2:
MsgBox ("Only 2 worksbooks are allowed - the original workbook and
the new workbook")
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

You may be making this more difficult than it needs to be? Both files
same sheet structure___?
As I understand it you want to copy what part of each worksheet
__________in the source file to the same sheet in the destination
file. Where on the destination sheet_______.
=======

On Oct 11, 8:50*am, jycpooh wrote:
Hello
I modified John Walkenbach’s CopyMultipleSelection to copy multiple
areas from each worksheet in workbook AA to worksheet in workbook BB.
All the sheets in BB will have the same name as those in AA. Example:
Copy selected areas in worksheet “LA” in workbook AA to similarly
named worksheet “LA” in workbook BB.

Here are the modified codes. It errors out on the line
SelAreas(i).Copy pasteRange.Offset(RowOffset, ColOffset).
*I would appreciate someone pointing me in the right direction.

Sub CopyMultipleSelection()
'This code is in a module in workbook BB

Dim qq As Integer: Dim tt As Integer
Dim BB As Workbook: Set BB = ThisWorkbook
Dim rAcells As Range:
Dim SelAreas() As Range: * *Dim PasteRange As Range:
Dim UpperLeft As Range: * *Dim NumAreas As Integer, i As Integer
Dim TopRow As Long, LeftCol As Integer: * *Dim RowOffset As Long,
ColOffset As Integer

Application.Calculation = xlCalculationManual

qq = 0
For tt = 1 To Workbooks.Count
*If Windows(Workbooks(tt).Name).Visible = True Then
* *qq = qq + 1
* *If BB.Name < Workbooks(tt).Name Then
* * *Windows(Workbooks(tt).Name).Activate
* * *Range("F11").Value = BB.Name * ' In workbook AA, set name of
workbook BB
* *End If
*End If
Next tt
If qq = 1 Then GoTo WarningMessage
If qq 2 Then GoTo WarningMessage2

If BB.Name < Range("F11").Value Then
Windows(Range("F11").Value).Activate * 'activate workbook AA
Set rAcells = ActiveSheet.Range("E15:CI86")
Dim rNumTextcells As Range:
On Error Resume Next: Set rNumTextcells =
rAcells.SpecialCells(xlCellTypeConstants) * 'select areas in AA to
copy to workbook BB

ActiveSheet.Range("F10") = ActiveSheet.Name * 'name of worksheet in AA

rNumTextcells.Select: 'areas selected to copy to worksheet in BB

' * Store the areas as separate Range objects
* * NumAreas = Selection.Areas.Count
* * ReDim SelAreas(1 To NumAreas)
* * For i = 1 To NumAreas
* * * * Set SelAreas(i) = Selection.Areas(i)
* * Next

' * Determine the upper left cell in the multiple selection
* * TopRow = ActiveSheet.Rows.Count
* * LeftCol = ActiveSheet.Columns.Count

* * For i = 1 To NumAreas
* * * * If SelAreas(i).Row < TopRow Then TopRow = SelAreas(i).Row
* * * * If SelAreas(i).Column < LeftCol Then LeftCol =
SelAreas(i).Column
* * Next
* * Set UpperLeft = Cells(TopRow, LeftCol)

* * On Error Resume Next

* * On Error GoTo 0

' * Make sure only the upper left cell is used
* * Set PasteRange = UpperLeft.Range("A1")
* * Set PasteRange =
Workbooks(Range("F11").Value).Worksheets(Range("F1 0").Value).Range(PasteRan ge.Address)
'determine the upper left cell in workbook BB

* * For i = 1 To NumAreas
* * * * RowOffset = SelAreas(i).Row - TopRow
* * * * ColOffset = SelAreas(i).Column - LeftCol
* * * * SelAreas(i).Copy PasteRange.Offset(RowOffset, ColOffset)
* * Next i

* * Range("F11").ClearContents: Range("F10").ClearContents
* * Application.Calculation = xlCalculationAutomatic
Exit Sub

WarningMessage:
*MsgBox ("Only 1 worksbook in windows - you need 2 workbooks to run
this macro")
*Application.Calculation = xlCalculationAutomatic
*Application.ScreenUpdating = True
Exit Sub

WarningMessage2:
*MsgBox ("Only 2 worksbooks are allowed - the original workbook and
the new workbook")
*Application.Calculation = xlCalculationAutomatic
*Application.ScreenUpdating = True
End Sub

On Oct 11, 9:49*am, Don Guillett wrote:
You may be making this more difficult than it needs to be? Both files
same sheet structure___?
As I understand it you want to copy what part of each worksheet
__________in the source file to the same sheet in the destination
file. Where on the destination sheet_______.


Hi Don,
Yes, both files same structure.
I need to copy only constants and text values from workbook AA to BB.
The reason I need a macro is because I may have 20 or more worksheets
in workbook AA. These worksheets contain many cells with formula which
I don't want to copy to corresponding worksheets in workbook BB. The
named ranges in AA may have been redefined in BB so I only copy
constants and text from each worksheet in AA to corresponding
worksheet in BB.
Any suggestion on why above code errors out would be most appreciated.
Thanks
Jim Chee
Houston, TX

On Oct 11, 10:34*am, jycpooh wrote:
On Oct 11, 9:49*am, Don Guillett wrote:

You may be making this more difficult than it needs to be? Both files
same sheet structure___?
As I understand it you want to copy what part of each worksheet
__________in the source file to the same sheet in the destination
file. Where on the destination sheet_______.

Hi Don,
Yes, both files same structure.
I need to copy only constants and text values from workbook AA to BB.
The reason I need a macro is because I may have 20 or more worksheets
in workbook AA. These worksheets contain many cells with formula which
I don't want to copy to corresponding worksheets in workbook BB. The
named ranges in AA may have been redefined in BB so I only copy
constants and text from each worksheet in AA to corresponding
worksheet in BB.
Any suggestion on why above code errors out would be most appreciated.
Thanks
Jim Chee
Houston, TX

I still don't know what you want but it is doable, probably using
special cells.

Send your file(s) with a complete explanation and before/after
examples to

On Oct 11, 1:45*pm, Don Guillett wrote:
On Oct 11, 10:34*am, jycpooh wrote:









On Oct 11, 9:49*am, Don Guillett wrote:

You may be making this more difficult than it needs to be? Both files
same sheet structure___?
As I understand it you want to copy what part of each worksheet
__________in the source file to the same sheet in the destination
file. Where on the destination sheet_______.

Hi Don,
Yes, both files same structure.
I need to copy only constants and text values from workbook AA to BB.
The reason I need a macro is because I may have 20 or more worksheets
in workbook AA. These worksheets contain many cells with formula which
I don't want to copy to corresponding worksheets in workbook BB. The
named ranges in AA may have been redefined in BB so I only copy
constants and text from each worksheet in AA to corresponding
worksheet in BB.
Any suggestion on why above code errors out would be most appreciated.
Thanks
Jim Chee
Houston, TX

I still don't know what you want but it is doable, probably using
special cells.

Send your file(s) with a complete explanation and before/after
examples to

dguillett