B
BeSmart
Hi All
I'm a novice trying to adapt code that I found on
http://www.rondebruin.nl/copy2.htm (which is really good), but I'm having a
little trouble and I have Two questions:
1. I need to merge data within all worksheets EXCEPT:
Sheet("Overview")
Hidden sheets
Destination Sheet
I tried to add to the existing code that excludes the destination sheet &
hidden sheets, but my change didn't work?
For Each sh In ActiveWorkbook.Worksheets
If sh.Name = "Overview" And sh.Name <> DestSh.Name And sh.Visible = True Then
'do nothing
2. I want to include a named range in my code instead of actual cell ranges
i.e.
Range("A18:BJ39") = "GRPResults" named range
This named range is the same across all 6 worksheets that need to be merged
I'm thinking that it's better to use a named range because it will
automatically expand if the user inserts rows - whereas a set cell range will
not?
Please can you show me how the following code should look using the named
ranges versus an actual range (occurs twice in the code before):
Sub CopyGRPSections()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long
Dim lastrow As Variant
lastrow = Range("A40")
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("GRP Data Collection").Select
Cells.Select
Selection.Clear
Range("A1").Select
Set DestSh = ActiveWorkbook.Worksheets("GRP Data Collection")
StartRow = 1
''''I need to loop through all worksheets but exclude those hidden, the
Overview & Destination sheet
For Each sh In ActiveWorkbook.Worksheets
If sh.Name = "Overview" And sh.Name <> DestSh.Name And sh.Visible = True Then
'''''do nothing
''''''' How do I change the range to Go to "GRPResults" named range in all
worksheets that meet the above criteria?
If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
Range("A18:BJ39").Select
Selection.Copy
With DestSh.Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
End If
Last = DestSh.Range("A" & Rows.Count).End(xlUp).Row
shLast = sh.Range("A" & Rows.Count).End(xlUp).Row
''''''' How do I change the range to Go to "GRPResults" named range in all
worksheets that meet the above criteria?
If shLast > 0 And shLast >= StartRow Then
Set CopyRng = sh.Range("A18:BJ39")
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
Application.ScreenUpdating = True
Application.EnableEvents = True
End With
End Sub
I'm a novice trying to adapt code that I found on
http://www.rondebruin.nl/copy2.htm (which is really good), but I'm having a
little trouble and I have Two questions:
1. I need to merge data within all worksheets EXCEPT:
Sheet("Overview")
Hidden sheets
Destination Sheet
I tried to add to the existing code that excludes the destination sheet &
hidden sheets, but my change didn't work?
For Each sh In ActiveWorkbook.Worksheets
If sh.Name = "Overview" And sh.Name <> DestSh.Name And sh.Visible = True Then
'do nothing
2. I want to include a named range in my code instead of actual cell ranges
i.e.
Range("A18:BJ39") = "GRPResults" named range
This named range is the same across all 6 worksheets that need to be merged
I'm thinking that it's better to use a named range because it will
automatically expand if the user inserts rows - whereas a set cell range will
not?
Please can you show me how the following code should look using the named
ranges versus an actual range (occurs twice in the code before):
Sub CopyGRPSections()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long
Dim lastrow As Variant
lastrow = Range("A40")
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("GRP Data Collection").Select
Cells.Select
Selection.Clear
Range("A1").Select
Set DestSh = ActiveWorkbook.Worksheets("GRP Data Collection")
StartRow = 1
''''I need to loop through all worksheets but exclude those hidden, the
Overview & Destination sheet
For Each sh In ActiveWorkbook.Worksheets
If sh.Name = "Overview" And sh.Name <> DestSh.Name And sh.Visible = True Then
'''''do nothing
''''''' How do I change the range to Go to "GRPResults" named range in all
worksheets that meet the above criteria?
If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
Range("A18:BJ39").Select
Selection.Copy
With DestSh.Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
End If
Last = DestSh.Range("A" & Rows.Count).End(xlUp).Row
shLast = sh.Range("A" & Rows.Count).End(xlUp).Row
''''''' How do I change the range to Go to "GRPResults" named range in all
worksheets that meet the above criteria?
If shLast > 0 And shLast >= StartRow Then
Set CopyRng = sh.Range("A18:BJ39")
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
Application.ScreenUpdating = True
Application.EnableEvents = True
End With
End Sub