Copy Rows Meeting Conditions to Another Worksheet

• We are practicing how to build a loop here. This is more efficiently handled using the Range.AutoFilter method and/or by introducing data structures (arrays, collections, dictionaries).

Source

Destination

A Quick Fix

• Copies the values of specific columns of each source row, where all conditions are met, to specific columns of the first available destination row.

Sub ImportNewData()
    
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source
    Dim sws As Worksheet: Set sws = wb.Sheets("Master")
    Dim sLastRow As Long:
    sLastRow = sws.Cells(sws.Rows.Count, "BU").End(xlUp).Row
    ' It could also be either 'R' or 'G' but their values aren't copied.
    
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Sheets("Bun_Dept")
    Dim dRow As Long: dRow = dws.Cells(dws.Rows.Count, "L").End(xlUp).Row
    
    ' Declare additional variables.
    Dim sRow As Long, AreConditionsMet As Boolean
    
    ' Loop (iterate) through the rows of the source worksheet.
    For sRow = 5 To sLastRow
        AreConditionsMet = False ' reset for each iteration
        ' Check if the conditions are met.
        If CStr(sws.Cells(sRow, "BU").Value) <> "" Then
            If CStr(sws.Cells(sRow, "R").Value) = "BUN" Then
                If CStr(sws.Cells(sRow, "G").Value) = "Location" Then
                    AreConditionsMet = True
                End If
            End If
        End If
        ' If conditions are met, write to the next destination row.
        If AreConditionsMet Then
            dRow = dRow + 1
            dws.Cells(dRow, "B").Value = sws.Cells(sRow, "A").Value
            dws.Cells(dRow, "C").Value = sws.Cells(sRow, "B").Value
            dws.Cells(dRow, "D").Value = sws.Cells(sRow, "D").Value
            dws.Cells(dRow, "E").Value = sws.Cells(sRow, "E").Value
            dws.Cells(dRow, "F").Value = sws.Cells(sRow, "BF").Value
            dws.Cells(dRow, "G").Value = sws.Cells(sRow, "BG").Value
            dws.Cells(dRow, "H").Value = sws.Cells(sRow, "Z").Value
            dws.Cells(dRow, "I").Value = sws.Cells(sRow, "Y").Value
            ' The following line determines the columns for the last rows!
            ' If there are empty cells at the bottom of source column 'BU',
            ' they will not be checked (increasing efficiency).
            ' More importantly, only rows containing non-blank ('<>""') values
            ' in source column 'BU' will be copied ensuring there will always
            ' be a value in column 'L' of the destination sheet.
            dws.Cells(dRow, "L").Value = sws.Cells(sRow, "BU").Value
            dws.Cells(dRow, "M").Value = sws.Cells(sRow, "BV").Value
        End If
    Next sRow

    ' Inform.
    MsgBox "New data imported.", vbInformation

End Sub

Your code has several problems:

• The first for loop does nothing. It loops through the rows, reading a value and assigning it to the variable k, and then immediately throws it away without using it to make the next loop. I don’t know what you intendd it to do, but you missed. I’ve removed it.

• You’ve got Next j in the wrong place. Your loop is running, doing nothing, because there’s nothing between For j and Next j. All the code that you want to execute has to be between the For and Next. The code where you’re trying to copy the data is just executing once.

• Your code formatting is a mess. If you properly indent the code, it’s much easier to follow the flow of execution when reading it or stepping through in the debugger.

Here’s an (untested) rework of your code to address those issues. Clearly, I don’t have your data to test it, and you didn’t post any sample data at all (which you should do).

Sub Values()
  Dim wb As Workbook
  Dim Data, Bun, Bun_Dept, Master As Worksheet
  Dim lastrow, lrow As Long
  Dim i As Integer
  Dim j As Integer

  Set Data = Worksheets("Master")
  Set Bun = Worksheets("Bun_Dept")

  lastrow = Data.Cells(Rows.Count, "A").End(xlUp).Row
  lrow = Bun.Cells(Rows.Count, "B").End(xlUp).Row
  For j = 4 To lrow
    If Data.Cells(i, 7) = "Location" And Data.Cells(i, 18) = "BUN" And Data.Cells(i, 73) <> "" Then
      Bun.Cells(j, 2) = Data.Cells(i, 1).Value: Bun.Cells(j, 3) = Data.Cells(i, 2).Value: Bun.Cells(j, 4) = Data.Cells(i, 4).Value
      Bun.Cells(j, 5) = Data.Cells(i, 5).Value: Bun.Cells(j, 6) = Data.Cells(i, 58).Value: Bun.Cells(j, 7) = Data.Cells(i, 59).Value
      Bun.Cells(j, 8) = Data.Cells(i, 26).Value: Bun.Cells(j, 9) = Data.Cells(i, 25).Value: Bun.Cells(j, 12) = Data.Cells(i, 73).Value
      Bun.Cells(j, 13) = Data.Cells(i, 74).Value
    End If
  Next j
End Sub

And speaking of the debugger, you need to learn to use it. You would have very quickly found the problem yourself by stepping through either one of those loops, especially the second one, because you would have seen it wasn’t doing what you wanted.