none
Copy a row of values from one worksheet to another RRS feed

  • Question

  • The following code copies up to 79 values/rows from one worksheet and pastes the first 38 values on the first page, skips 28 rows, and pastes the remaining values on the second page of my two page quote form.

    For 80+ values I want to use a three page quote. How do I configure this code to paste 43 values on the first page, skip 28 rows, paste another 43 values on the second page, skip another 28 rows, and paste the remaining values on the third page?

    Sub PullOptions2Pg_1()
        Application.Calculation = xlAutomatic
        Dim rngC As Range
        Dim rngQ As Range
        Dim iCnt As Integer
        iCnt = 0
        Set rngQ = Worksheets("QUOTE_2PG").Range("C39:C76,C105:C145")
        On Error Resume Next
        For Each rngC In rngQ
            rngC.ClearContents
            rngC.MergeArea.ClearContents
        Next rngC
        On Error GoTo 0
        For Each rngC In Worksheets("Package_Builder").Range("H6:H95")
            If rngC.Value > 0 Then
                iCnt = iCnt + 1
                If iCnt > 79 Then
                    MsgBox "Too many options chosen"
                    Exit Sub
                End If
                rngQ.Cells(iCnt + IIf(iCnt > 38, 28, 0)).Value = _
                Worksheets("Package_Builder").Cells(rngC.Row, 2).Value
            End If
        Next rngC
    End Sub
    Friday, August 15, 2014 8:50 PM

Answers

  • How do I configure this code to paste 43 values on the first page, skip 28 rows, paste another 43 values on the second page, skip another 28 rows, and paste the remaining values on the third page?

    Sub PullOptions2Pg_1()
      Dim rngC As Range
      Dim FirstRow As Long, iCnt As Long
    
      With Worksheets("QUOTE_2PG").Range("C39:C76,C105:C145")
        On Error GoTo ClearErrorHandler
        .ClearContents
        .MergeArea.ClearContents
        On Error GoTo 0
    
        FirstRow = 1
        For Each rngC In Worksheets("Package_Builder").Range("H6:H95")
          If rngC.Value > 0 Then
            .Cells(FirstRow + iCnt).Value = Worksheets("Package_Builder").Cells(rngC.Row, 2).Value
            iCnt = iCnt + 1
            If iCnt > 43 Then
              iCnt = 0
              FirstRow = FirstRow + 28
            End If
          End If
        Next
      End With
      
      Exit Sub
    ClearErrorHandler:
      Resume Next
    End Sub
    


    Saturday, August 16, 2014 8:28 AM