How to copy the column A to M from a row in sheet1 to sheet2 if it doesn't already exist-CodePudding

I would like to select some rows by putting an X in the column L, then copy selected row (Only column A to M) to the next free row in sheet2.

Free row mean there is nothing in the column A to M since there is content in the next column already filled.

The copy shouldn't erase the content already existing after column M.

The row can't be added if it's already in the sheet2 and to test this, I have an unique ID for the row in column M.

Some of the column of the row that should be copied are sometimes empty.

Part of what I tried :

Sub GAtoList()

    Dim xRg As Range

    Dim xCell As Range

    Dim A As Long

    Dim B As Long

    Dim L As Long
    

    A = Worksheets("knxexport").Range("d" & Worksheets("knxexport").Rows.Count)

    B = Worksheets("Sheet2").UsedRange.Rows.Count
    

    If B = 1 Then

    If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then B = 0

    End If

    Set xRg = Worksheets("knxexport").Range("L1:L" & A)

    Application.ScreenUpdating = False

    For L = 1 To xRg.Count

        If CStr(xRg(L).Value) = "X" Then

            xRg(L).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & B   1)

            B = B   1
            Cells(L, B).EntireRow.Interior.ColorIndex = 4


        End If

    Next
    'Erase the X that select the row I want to copy
    Worksheets("knxexport").Columns(12).ClearContents
    Worksheets("Sheet2").Columns(12).ClearContents
    Application.ScreenUpdating = True

End Sub

Column D is never empty so I use it to check the end of the source sheet

knxexport sheet where I take data

sheet2 where I want to copy them

CodePudding user response：

Please, test the next code:

Sub GAtoList()
 Dim sh As Worksheet, shDest As Worksheet, lastRL As Long, LastRM As Long
 Dim strSearch As String, rngM As Range, arrCopy, cellF As Range, rngL As Range, cellFAddress As String, i As Long, mtch
 
 strSearch = "X"
 Set sh = 'Worksheets("knxexport")   'the sheet to copy from
 Set shDest = 'Worksheets("Sheet2")  'the sheet to copy to
 shDest.Range("M:M").NumberFormat = "@" 'format the M:M column as text
 lastRL = sh.Range("L" & sh.rows.count).End(xlUp).row
 Set rngL = sh.Range("L2:L" & lastRL) 'the range to search for "X"
 Set cellF = rngL.Find(what:=strSearch, After:=sh.Range("L2"), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False)
 If Not cellF Is Nothing Then     'If at least an "X" string has been found:
    cellFAddress = cellF.Address  'memorize its (first) address
    Do
        LastRM = shDest.Range("M" & shDest.rows.count).End(xlUp).row 'last row in M:M
        If LastRM > 1 Then  'if there already are IDs:
            Set rngM = shDest.Range("M2:M" & LastRM)
            mtch = Application.match(sh.cells(cellF.row, "M").Value, rngM, 0)
            If IsError(mtch) Then 'no ID found
                shDest.Range("A" & LastRM   1 & ":" & "M" & LastRM   1).Value = _
                       sh.Range(sh.Range("A" & cellF.row), sh.Range("M" & cellF.row)).Value
            Else
                Debug.Print sh.cells(cellF.row, "M").Value & " already existing..." 'warn in case of ID existence...
            End If
        Else
            'copy in the second row
            shDest.Range("A2:M2").Value = _
                       sh.Range(sh.Range("A" & cellF.row), sh.Range("M" & cellF.row)).Value
        End If
        Set cellF = rngL.FindNext(cellF)
    Loop While cellF.Address <> cellFAddress 'exit to avoid restarting loop from the memorized address   
 Else
    MsgBox strSearch & " could not be found in ""L:"" column...": Exit Sub
 End If
End Sub