Macro Correction(copy & paste between two sheets if condition met)

[zyxw1234]

Hi Experts,

Code: Select all

Sub STEP12()
    Application.ScreenUpdating = False
    Dim LastRow As Long, lCol As Long, x As Long, srcWS As Worksheet, desWS As Worksheet
    Dim Wb As Workbook
    Set Wb = Activeworkbook
    Set srcWS = Wb.Worksheets.Item(1)
    Set desWS = Wb.Worksheets.Item(2)
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For x = 2 To LastRow
        With srcWS
            lCol = .Cells(x, .Columns.Count).End(xlToLeft).Column
            If lCol - 2 >= 5 Then
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 3) = Array(.Cells(x, 1), .Cells(x, 2), lCol - 2)
            End If
        End With
    Next x
    Application.DisplayAlerts = False
    wb.save
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

This macro pastes the data from sheet 1 to sheet2 but little changes are there in this macro
plz see the sample file

[HansV]

You don't give up easily, do you?

[Leif]

Locked to avoid wasting everyone's time.