Sub CopyExtendColumnsFandJ()
Dim X As Long
Dim Frow As Long
Dim LastDataRow As Long
Const DataStartRow As Long = 2
Const Source As String = "Sheet2"
Const Destination As String = "Sheet3"
With Worksheets(Source)
LastDataRow = .Cells(.Rows.Count, "J").End(xlUp).Row
Frow = DataStartRow
For X = DataStartRow To LastDataRow
If .Cells(X, "J").Value <> "" Then
If .Cells(X, "F").Value = "" Then
Worksheets(Destination).Cells(X, "F").Value = .Cells(Frow,
"F").Value
Else
Frow = X
Worksheets(Destination).Cells(X, "F").Value = .Cells(X, "F").Value
End If
Worksheets(Destination).Cells(X, "J").Value = .Cells(X, "J").Value
Else
Frow = X
End If
Next
End With
End Sub
|