Erreur code VBA

bonjour a tous

voici mon code qui permet de copie colle sur une autre feuille

'===========================
'copier/coller des données
'===========================

Sub copier_coller()

Dim wk_file As Workbook
Dim ws_data As Worksheet
Dim ws_export As Worksheet
Dim lstrw As Long, lstcol As Long
Dim lscol_export As Long
Dim intitule As String, intitule_a_trouver As String
Dim intitule_trouver As Boolean
Dim col_destination As Long
Dim rw_copy As Long

'idendifier le fichier et les onglets
Set wk_file = ActiveWorkbook
Set ws_data = wk_file.Worksheets(1)
Set ws_export = wk_file.Worksheets(2)

'idendifier la dernière ligne et colonne des donnés brute
lstrw = ws_data.Cells(Rows.Count, 1).End(x1up).Row
lscol = ws_data.Cells(1, columms.Count).End(x1toleft).columm
lscol_export = ws_data.Cells(1, columms.Count).End(x1toleft).columm

'boucle sur les ligne des données
For i = 2 To lstrw

    'identifier ligne de collage
    rw_copy = ws_export.Cells(Rows.Count, 1).End(x1up).Row + 1

    'boucle sur les colonne des données
    For j = 1 To lscol
        'identifier l'intitule à trouver
        intitule_a_trouver = ws_data.Cells(1, j)
        intitule_trouver = False

        'boucle sur les colonne de l'export
        For k = 1 To lscol_export
            intitule = ws_export.Cells(1, k)

            If intitule = intitule_a_trouver Then
                intutile_trouver = True
                col_destination = k
            End If
    Next

    'coller l'info sur export
    If intiutle_trouver = True Then

        ws_export.Cells(rw_copy, col_destination) = ws_data.Cells(i, j)
    End If
Next

Next
End Sub

merci pour votre aide

Hello,

les énumérations XlDirection doivent correspondre STRICTEMENT à ce qui est attendu

x1up est différent de xlUp

https://learn.microsoft.com/fr-fr/office/vba/api/excel.xldirection

Edit, il y a plein d'erreur de frappes et donc de variables inexistantes

Ex : Dim lstrw As Long, lstcol As Long
lscol = ws_data... manque le t

Veuillez ajouter : Options explicit tout en haut et utilise la commande Débogage, Compiler VBA Project, vous allez vous apercevoir de pas mal de chose

On dirait un code (mal) recopié d'un bouquin

tous vos "(x1toleft)", "(x1Up) etc, il y a un "1" au lieu d'un "l" (lettre L)

donc remplacer tous les "(x1" par "(xl" ou 1 par 1 ???

merci

un grand merci a tous

j'ai une petite question

quand j'exécute la macro, sa me recopie les données déjà copie une idée pour remédier a sa

fichier mis a jour

merci a tous

Fallait demander à chatGPT de ne pas copier les doublons. Voilà sa réponse

Sub CopierUniquementLignesNonDupliquées()

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long
    Dim header1 As Range, header2 As Range
    Dim dict As Object
    Dim colMap As Object
    Dim i As Long, j As Long
    Dim tempRow() As Variant
    Dim key As String

    Set ws1 = ThisWorkbook.Sheets("Feuil1")
    Set ws2 = ThisWorkbook.Sheets("Feuil2")
    Set dict = CreateObject("Scripting.Dictionary")
    Set colMap = CreateObject("Scripting.Dictionary")

    ' Obtenir les en-têtes
    lastRow1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row

    Set header1 = ws1.Range(ws1.Cells(1, 1), ws1.Cells(1, ws1.Columns.Count).End(xlToLeft))
    Set header2 = ws2.Range(ws2.Cells(1, 1), ws2.Cells(1, ws2.Columns.Count).End(xlToLeft))

    ' Créer correspondance entre les colonnes (Feuille2 ? Feuille1)
    For j = 1 To header2.Columns.Count
        For i = 1 To header1.Columns.Count
            If Trim(header2.Cells(1, j).Value) = Trim(header1.Cells(1, i).Value) Then
                colMap(j) = i
                Exit For
            End If
        Next i
    Next j

    ' Charger les lignes existantes de Feuille2 dans le dictionnaire
    For i = 2 To lastRow2
        key = ""
        For j = 1 To header2.Columns.Count
            key = key & "|" & LCase(Trim(ws2.Cells(i, j).Value))
        Next j
        dict(key) = True
    Next i

    ' Ajouter les nouvelles lignes depuis Feuille1
    For i = 2 To lastRow1
        ReDim tempRow(1 To header2.Columns.Count)
        For j = 1 To header2.Columns.Count
            If colMap.exists(j) Then
                tempRow(j) = ws1.Cells(i, colMap(j)).Value
            Else
                tempRow(j) = "" ' Colonne absente dans Feuille1
            End If
        Next j

        ' Générer une clé propre pour comparaison
        key = ""
        For j = 1 To header2.Columns.Count
            key = key & "|" & LCase(Trim(tempRow(j)))
        Next j

        ' Ajouter la ligne uniquement si elle est absente
        If Not dict.exists(key) Then
            lastRow2 = lastRow2 + 1
            For j = 1 To header2.Columns.Count
                ws2.Cells(lastRow2, j).Value = tempRow(j)
            Next j
            dict(key) = True
        End If
    Next i

    MsgBox "Copie terminée sans doublons."

End Sub