Paste loop is not pasting values-CodePudding

Sub buildPlan()
'
' buildPlan Macro
'
    
   Dim wb As Workbook
    Dim rwDest As Range, rw As Range, valQ, valT
    Dim nwb As Workbook, wsAPP As Worksheet, wsDNDR As Worksheet
    
    Set wb = Application.ActiveWorkbook           'ThisWorkbook?
    Set wsAPP = wb.Worksheets("Arils Pack Plan ") 'trailing space?
    
    'Opening Recent ATS report
     With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
        .AllowMultiSelect = False
        .Show
    Application.Workbooks.Open .SelectedItems(1)
    Set nwb = Application.ActiveWorkbook

    End With
    
    
    Set wsDNDR = nwb.Worksheets("DAILY NEED (DR)")
    
    Set rwDest = wsAPP.Rows(7) 'start row for results
    
    '4oz Day 1 -----------------------------------------------------------------------
    
    For Each rw In wsDNDR.Range("Q5:Q14").Rows
        valQ = rw.Columns("Q").Value
        If valQ < 0 Then
            rwDest.Columns("B7").Value = rw.Columns("B7").Value 'SKU
            Set rwDest = rwDest.Offset(1) 'Next row
        End If
    Next rw
    
    
    For Each rw In wsDNDR.Range("Q5:Q14").Rows
        valQ = rw.Columns("Q").Value
        If valQ < 0 Then
            rwDest.Columns("E7").Value = rw.Columns("E7").Value 'VALUE
            Set rwDest = rwDest.Offset(1) 'Next row
        End If
    Next rw

    For Each rw In wsDNDR.Range("Q5:Q14").Rows
        valQ = rw.Columns("Q").Value
        If valQ < 0 Then
            rwDest.Columns("F7").Value = valQ 'Value
            Set rwDest = rwDest.Offset(1) 'Next row
        End If
    Next rw

    '4oz Day 2---------------------------------------------------------------------------------------
    
    For Each rw In wsDNDR.Range("T5:T14").Rows
        valT = rw.Columns("T").Value
        If valT < 0 Then
            rwDest.Columns("B7").Value = rw.Columns("B7").Value 'SKU
            Set rwDest = rwDest.Offset(1) 'Next row
        End If
    Next rw
    
    
   For Each rw In wsDNDR.Range("T5:T14").Rows
        valT = rw.Columns("T").Value
        If valT < 0 Then
            rwDest.Columns("E7").Value = rw.Columns("E7").Value 'Pallet Type
            Set rwDest = rwDest.Offset(1) 'Next row
        End If
    Next rw


    For Each rw In wsDNDR.Range("T5:T14").Rows
        valT = rw.Columns("T").Value
        If valT < 0 Then
            rwDest.Columns("F7").Value = valT 'Value
            Set rwDest = rwDest.Offset(1) 'Next row
        End If
    Next rw


    '8oz Day 1---------------------------------------------------------------------------------------------

    For Each rw In wsDNDR.Range("Q15:Q26").Rows
        valQ = rw.Columns("Q").Value
        If valQ < 0 Then
            rwDest.Columns("B7").Value = rw.Columns("B7").Value 'SKU
            Set rwDest = rwDest.Offset(1) 'Next row
        End If
    Next rw
    
    
   For Each rw In wsDNDR.Range("Q15:Q26").Rows
        valQ = rw.Columns("Q").Value
        If valQ < 0 Then
            rwDest.Columns("E7").Value = rw.Columns("E7").Value 'Pallet Type
            Set rwDest = rwDest.Offset(1) 'Next row
        End If
    Next rw


    For Each rw In wsDNDR.Range("Q15:Q26").Rows
        valQ = rw.Columns("Q").Value
        If valQ < 0 Then
            rwDest.Columns("F7").Value = valQ 'Value
            Set rwDest = rwDest.Offset(1) 'Next row
        End If
    Next rw

    '8oz Day 2---------------------------------------------------------------------------------------------
        
    For Each rw In wsDNDR.Range("T15:T26").Rows
        valT = rw.Columns("T").Value
        If valT < 0 Then
            rwDest.Columns("B7").Value = rw.Columns("B7").Value 'SKU
            Set rwDest = rwDest.Offset(1) 'Next row
        End If
    Next rw
    
    
   For Each rw In wsDNDR.Range("T15:T26").Rows
        valT = rw.Columns("T").Value
        If valT < 0 Then
            rwDest.Columns("E7").Value = rw.Columns("E7").Value 'Pallet Type
            Set rwDest = rwDest.Offset(1) 'Next row
        End If
    Next rw


    For Each rw In wsDNDR.Range("T15:T26").Rows
        valT = rw.Columns("T").Value
        If valT < 0 Then
            rwDest.Columns("F7").Value = valT 'Value
            Set rwDest = rwDest.Offset(1) 'Next row
        End If
    Next rw

End Sub

I am trying to paste the values from the Tracker to the Pack Plan if they are negative. I need to past the values from section 3 to column F in the pack plan. With its corresponding cells in section 1 and 2 from the tracker, then repeat that process if the values in section 4 are negative. Section 1 needs to be pasted in column B of the pack plan and section 2 needs to be pasted in column E of the pack plan. I need to finish the top sections (1-4) before moving onto the bottom sections (5-8). The process will be the same. I need to copy and paste the values with their corresponding cells in 5 and 6. Once the top section is pasted in the pack plan I need the bottom section to paste below the the top section on the pack plan.

CodePudding user response：

Here's a slight modification of my answer in your previous post:

Sub buildPlan()
    Dim wb As Workbook
    Dim rwDest As Range, rw As Range, sRng, rngLoop As Range
    Dim nwb As Workbook, wsAPP As Worksheet, wsDNDR As Worksheet
    
    Set wb = Application.ActiveWorkbook           'ThisWorkbook?
    Set wsAPP = wb.Worksheets("Arils Pack Plan ") 'trailing space?
    
    'Opening Recent ATS report
     With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
        .AllowMultiSelect = False
        If .Show = -1 Then Set nwb = Workbooks.Open(.SelectedItems(1))
    End With
    If nwb Is Nothing Then Exit Sub 'no file selected...
    Set wsDNDR = nwb.Worksheets("DAILY NEED (DR)")
    
    Set rwDest = wsAPP.Rows(7) 'start row for results
    
    For Each sRng In Array("A5:T14", "A15:T25") 'row ranges to loop over
        Set rngLoop = wsDNDR.Range(sRng)        'rows to loop over
        For Each rw In rngLoop.Rows
            CheckRow rw, rwDest, "Q" 'check col Q
        Next rw
        For Each rw In rngLoop.Rows
            CheckRow rw, rwDest, "T" 'check Col T
        Next rw
    Next sRng
End Sub

'If the value in column `onHandColLett` of `rwSrc` is negative
'   then transfer some values to `rwDest`
Sub CheckRow(rwSrc As Range, rwDest As Range, onHandColLett)
    Dim v
    v = rwSrc.Columns(onHandColLett).Value
    If v < 0 Then
        rwDest.Columns("B").Value = rwSrc.Columns("B").Value 'SKU
        rwDest.Columns("E").Value = rwSrc.Columns("E").Value 'pallet
        rwDest.Columns("F").Value = v                        'on hand value
        Set rwDest = rwDest.Offset(1)                        'Next row
    End If
End Sub