Try the following code (it is a generic solution supporting multiple copy instructions and multiple block types/templates)
Public Sub copyPowerBlocks()
On Error Resume Next
'#
'# declare private variables
'#
Dim pvt_dct_Block As Object
Dim pvt_obj_Range As Excel.Range
Dim pvt_xls_Target As Excel.Worksheet
Dim pvt_lng_MaxRow As Long
Dim pvt_str_BlockName As String
Dim pvt_lng_StartRow As Long
Dim pvt_lng_RowNumber As Long
Dim pvt_int_Repeat As Integer
Dim pvt_lng_TargetRow As Long
Dim pvt_lng_Offset As Long
'#
'# initialise
'#
Set pvt_dct_Block = CreateObject("Scripting.Dictionary")
Set pvt_xls_Target = ThisWorkbook.Worksheets("Sheet3")
'#
'# load the dictionary object with the named block ranges from worksheet 2
'#
With ThisWorkbook.Worksheets("Sheet2")
pvt_lng_MaxRow = .Cells(.Rows.Count, "D").End(xlUp).Row
For pvt_lng_RowNumber = 2 To (pvt_lng_MaxRow + 1)
If Len(.Cells(pvt_lng_RowNumber, "A").Value & "") > 0 Or pvt_lng_RowNumber > pvt_lng_MaxRow Then
If Len(pvt_str_BlockName) > 0 Then
pvt_dct_Block.Add pvt_str_BlockName, .Cells(pvt_lng_StartRow, "A").Resize((pvt_lng_RowNumber - pvt_lng_StartRow), 6)
End If
pvt_str_BlockName = Trim$(.Cells(pvt_lng_RowNumber, "A").Value)
pvt_lng_StartRow = pvt_lng_RowNumber
End If
Next pvt_lng_RowNumber
End With
'#
'# clear the target worksheet
'#
pvt_xls_Target.Cells.ClearContents
'#
'# loop for the copy block instructions provided on the first worksheet
'#
With ThisWorkbook.Worksheets("Sheet1")
For pvt_lng_RowNumber = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
If pvt_dct_Block.Exists(.Cells(pvt_lng_RowNumber, "A").Value) Then
'#
'# get the value of the hexadecimal offset -/- 4
'#
pvt_lng_Offset = Val("&H" & CStr(.Cells(pvt_lng_RowNumber, "B").Value)) - 4
'#
'# get the template block from the dictionary
'#
Set pvt_obj_Range = pvt_dct_Block(.Cells(pvt_lng_RowNumber, "A").Value)
'#
'# for the repeat count
'#
For pvt_int_Repeat = 1 To CInt(.Cells(pvt_lng_RowNumber, "C").Value)
'#
'# get the first available row on the target worksheet, include special processing for
'# the first row
'#
pvt_lng_StartRow = pvt_xls_Target.Cells(pvt_xls_Target.Rows.Count, "D").End(xlUp).Offset(1).Row
If pvt_lng_StartRow = 2 Then pvt_lng_StartRow = 1
'#
'# copy the template block onto the target worksheet
'#
pvt_xls_Target.Cells(pvt_lng_StartRow, "A").Resize(pvt_obj_Range.Rows.Count, pvt_obj_Range.Columns.Count).Value = pvt_obj_Range.Value
'#
'# correct the offset values for the copied block
'#
With pvt_xls_Target
For pvt_lng_TargetRow = pvt_lng_StartRow To (pvt_lng_StartRow + pvt_obj_Range.Rows.Count)
If Len(.Cells(pvt_lng_TargetRow, "B")) > 0 Then
pvt_lng_Offset = pvt_lng_Offset + 4
.Cells(pvt_lng_TargetRow, "C").Value = Hex(pvt_lng_Offset)
End If
Next pvt_lng_TargetRow
End With
Next pvt_int_Repeat
End If
Next pvt_lng_RowNumber
End With
End Sub
Bookmarks