Excel Forum

Code: Select all

Sub test()

Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim lastRow As Long
    Dim targetRow As Long
    Dim col As String

    ' Set the source worksheet
    Set wsSource = ActiveSheet

    ' Create a new worksheet for the target
    Set wsTarget = Worksheets.Add
    wsTarget.Name = "TargetSheet"

    ' Specify the column to check (e.g., "A" for column A)
    col = "i"

    ' Initialize the target row
    targetRow = 1

    ' Loop through each row from the bottom up
    lastRow = wsSource.Cells(wsSource.Rows.Count, col).End(xlUp).Row
    For i = lastRow To 1 Step -1
        Set cell = wsSource.Cells(i, col)

        ' Check if the cell in the specified column is not empty
        If cell.Value <> "" Then
            ' Copy the row to the target sheet
            wsSource.Rows(i).Copy Destination:=wsTarget.Rows(targetRow)
            ' Delete the row from the source sheet
            wsSource.Rows(i).EntireRow.Delete
            ' Move to the next row in the target sheet
            targetRow = targetRow + 1
        End If
    Next i
End Sub