S
Sam Fowler
Hi All:
I have a master worksheet that holds several types of data. I also have 10
worksheets (in the same workbook) that may, or may not contain data that I
need to copy to the master sheet. I am a bit of a novice with VBA, but have
gotten the following code to work. However, I would like to either copy row
heights, or possibly the entire row. Each secondary worksheet contains 10
pages, each 67 rows long. Columns are the same width as the master sheet
(Some Cells are merged)
Can anyone help me get this to perform the checks and then copy the entire
row?
The current code is as follows:
Sub Data_Ranges_Copy_and_Clear()
Dim vCopySheets As Variant
Dim vCheckPoints As Variant
Dim vCopyRange As Variant
Dim rng As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim iCounter As Integer
Dim iCounter2 As Integer
vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", "OS
Claim", "Fact PS", "OS PS", "Prepaid", "Sold During")
'Select each sheet in turn
For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
Sheets(vCopySheets(iCounter)).Select
'Cells on this sheet to test
vCheckPoints = Array("A619", "A552", "A485", "A418", "A351", "A284",
"A217", "A147", "A83", "A16")
'Corresponding ranges to copy
vCopyRange = Array("A1670", "A1603", "A1536", "A1469",
"A1402", "A1335", "A1268", "A1201", "A1134", "A167")
For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
Set rng = Range(vCheckPoints(iCounter2))
If Not (IsEmpty(rng)) Then
'set copy area
Set Rng2 = Range(vCopyRange(iCounter2))
'Before copying find pasting point
Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1, 0)
'Now copy to other sheet
With Rng2
.Copy Rng3
' .ClearContents
End With
'Items found and copied so get out of (inner)loop
Exit For
End If
Next
'Move on to next sheet
Next
' Now Clear Data Ranges
Dim ws As Worksheet, i As Long
For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", "Fact
Claim", "OS Claim", "Fact PS", "OS PS", "Prepaid", "Sold During"))
For i = 0 To 9
ws.Range("A16:L63").Offset(i * 67).ClearContents
Next i
Next
Sheets("INV").Select
End Sub
Oh, I forgot to mention, when the copy and paste is complete, I need the
original data cleared.
Thanks,
I have a master worksheet that holds several types of data. I also have 10
worksheets (in the same workbook) that may, or may not contain data that I
need to copy to the master sheet. I am a bit of a novice with VBA, but have
gotten the following code to work. However, I would like to either copy row
heights, or possibly the entire row. Each secondary worksheet contains 10
pages, each 67 rows long. Columns are the same width as the master sheet
(Some Cells are merged)
Can anyone help me get this to perform the checks and then copy the entire
row?
The current code is as follows:
Sub Data_Ranges_Copy_and_Clear()
Dim vCopySheets As Variant
Dim vCheckPoints As Variant
Dim vCopyRange As Variant
Dim rng As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim iCounter As Integer
Dim iCounter2 As Integer
vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", "OS
Claim", "Fact PS", "OS PS", "Prepaid", "Sold During")
'Select each sheet in turn
For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
Sheets(vCopySheets(iCounter)).Select
'Cells on this sheet to test
vCheckPoints = Array("A619", "A552", "A485", "A418", "A351", "A284",
"A217", "A147", "A83", "A16")
'Corresponding ranges to copy
vCopyRange = Array("A1670", "A1603", "A1536", "A1469",
"A1402", "A1335", "A1268", "A1201", "A1134", "A167")
For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
Set rng = Range(vCheckPoints(iCounter2))
If Not (IsEmpty(rng)) Then
'set copy area
Set Rng2 = Range(vCopyRange(iCounter2))
'Before copying find pasting point
Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1, 0)
'Now copy to other sheet
With Rng2
.Copy Rng3
' .ClearContents
End With
'Items found and copied so get out of (inner)loop
Exit For
End If
Next
'Move on to next sheet
Next
' Now Clear Data Ranges
Dim ws As Worksheet, i As Long
For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", "Fact
Claim", "OS Claim", "Fact PS", "OS PS", "Prepaid", "Sold During"))
For i = 0 To 9
ws.Range("A16:L63").Offset(i * 67).ClearContents
Next i
Next
Sheets("INV").Select
End Sub
Oh, I forgot to mention, when the copy and paste is complete, I need the
original data cleared.
Thanks,