Help modifying code to transfer data to continuation sheet please.

[ElmerFud]

Having problems with VBA code below transferring rows & columns from sheet2 (armele) to sheet1 (Purchase Order) starting at "Materials" & "Price rows & columns (F14:I33) down to (F33:I33) then continuing with next column on page1 "Materials" & "Price" rows & columns (O14:T14) down to (O33:T33).

Would also like it to continue to page2 "Materials" & "Price" rows & columns (F39:I39) down to (F:68:I68) then to "Materials" & "Price" rows & columns (O39:T39) down to and finishing at (O68:T68) Please see code below.

[/SIZE][/SIZE]Option ExplicitOption Base 1
Const IsChecked As String = "a"


Sub TransferData()
Dim ARMELE As Worksheet, REQFORM As Worksheet
Dim CheckList As Range, CheckBox As Range
Dim InvCount As Long, ReqRow As Long, UnitDivisor As Long, d As Long
Dim UnitIssue As String, DestM As Variant, DestP As Variant
Const strPassword As String = "Password"
ActiveSheet.Unprotect Password:=strPassword




On Error Resume Next
    DestM = Array(6, 15)                                            'material columns
    DestP = Array(9, 20)                                            'price columns
    Set ARMELE = Worksheets("armele")                               'source worksheet
    Set REQFORM = Worksheets("Purchase Order")                      'destination worksheet
    Set CheckList = ARMELE.Range("G:G").SpecialCells(xlConstants)   'cells with checkmarks


    If CheckList Is Nothing Then
        MsgBox "No items were checked to copy!"
        Exit Sub
    End If
    
    'next order-form row to fill, based on column F (Description)
    ReqRow = REQFORM.Cells(Rows.Count, "F").End(xlUp).Row + 1
    If ReqRow > 33 Then
        ReqRow = REQFORM.Cells(35, "O").End(xlUp).Row + 1
        If ReqRow > 33 Then
            MsgBox "Purchase Order Form is Full! ( Press OK to delete remaining check marks? )"
                    
        ' DeleteColumn Macro
        '


        '
    Columns("G:G").Select
    Selection.ClearContents
    Sheets("Purchase Order").Select
    Range("X10").Select
            Exit Sub
        End If
        d = 2   'destination array item
    Else
        d = 1   'destination array item
    End If
    
    For Each CheckBox In CheckList
        If CheckBox = IsChecked Then
        'material
            REQFORM.Cells(ReqRow, DestM(d)).Value = ARMELE.Cells(CheckBox.Row, "C").Value
            
        'price
            Select Case UCase(ARMELE.Cells(CheckBox.Row, "D").Value)
                Case Is = "C", "H", "J", "HU":            UnitDivisor = 100
                Case Is = "M", "T":                 UnitDivisor = 1000
                Case Is = "E", "F", "R", "B", "P", "RL", "BX", "PK", "CD", "FT", "KG", "PC", "JR":  UnitDivisor = 1
            End Select
            REQFORM.Cells(ReqRow, DestP(d)).Value = ARMELE.Cells(CheckBox.Row, "F").Value / UnitDivisor
            
            CheckBox = ""       'clear the check mark
            If ReqRow = 33 Then 'increment to next req form row/column
                If d = 2 Then
                    MsgBox "Purchase Order Form is Full! ( Press OK to delete remaining check marks? )"
                    
        ' DeleteColumn Macro
        '


        '
    Columns("G:G").Select
    Selection.ClearContents
    Sheets("Purchase Order").Select
    Range("X10").Select
               
                    Exit Sub
                Else
                    ReqRow = 14
                    d = 2
                End If
            Else
                ReqRow = ReqRow + 1
            End If
        End If
    Next CheckBox
    ActiveSheet.Protect Password:=strPassword
End Sub


[SIZE=3][SIZE=2]

 

[ElmerFud]

Well thanks anyways, guess it's too difficult of a task to take on. Everyone have a good day!