Transférer des données d'une feuille à une autre

Sub TriDansFeuille()  ' Définition des variables
  Dim DLig As Long, Lig As Long, ShtD As Worksheet
  Dim sMarque As String
  ' Avec l'objet feuille "Achats"
  With Sheets("Achats")
    ' Trouver la dernière ligne du tableau
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' pour chaque ligne à partir de la 2ème
    For Lig = 2 To DLig
      ' En cas d'erreur on continue la procédure
      On Error Resume Next
      ' Récupérer le nom de la marque
      sMarque = .Range("E" & Lig).Value
      ' Définir la feuille de destination = la marque
      Set ShtD = Sheets(sMarque)
      ' Si une erreur est renvoyée = la feuille n'existe pas => la créer
      If Err.Number <> 0 Then
        ' Empêcher le scintillement de l'écran
        Application.ScreenUpdating = False
        ' Créer la feuille
        Sheets.Add After:=Sheets(Sheets.Count)
        ' La renommer du nom de la marque
        ActiveSheet.Name = sMarque
        ' Définir la feuille de destination
        Set ShtD = Sheets(sMarque)
        ' activer la feuille des achats
        .Activate
        ' Copier la permière ligne
        .Rows(1).Copy Destination:=ShtD.Range("A1")
        ' Activer de nouveau le rafraichissement
        Application.ScreenUpdating = False
      End If
      ' Copier la ligne dans la feuille de destination
      ' sur la dernière ligne remplie + 1
      Rows(Lig).Copy Destination:=ShtD.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Next Lig
  End With
End Sub

Sub tata()
    Dim i&, l&, nChp&, calcEtat&, lstFl(), dicFl As New Dictionary, tmp As Range, plgChp As Range, aFl As Worksheet, pFl As Worksheet
    With Sheets("Achats")
        With .Range("A1")
            Set plgChp = .Parent.Range(.Cells, .Parent.Cells(.Row, .Parent.Columns.Count).End(xlToLeft))
            For nChp = 1 To plgChp.Count
                If LCase(plgChp(nChp).Value) = "marque" Then Exit For
            Next
        End With
        If nChp <= plgChp.Count Then
            Set tmp = .Range(plgChp(nChp), .Cells(.Rows.Count, plgChp(nChp).Column).End(xlUp))
            For i = 2 To tmp.Count
                If Not dicFl.Exists(CStr(tmp(i).Value)) Then dicFl.Add CStr(tmp(i).Value), 1
            Next
            If dicFl.Count > 0 Then
                lstFl = dicFl.Keys
                Set dicFl = Nothing
                With Application: .ScreenUpdating = 0: calcEtat = .Calculation: .Calculation = -4135: .EnableEvents = 0: End With
                Set pFl = ActiveSheet
                With plgChp.Resize(tmp.Count, plgChp.Count)
                    For i = 0 To UBound(lstFl)
                        On Error Resume Next
                        Set aFl = Sheets(lstFl(i))
                        If Err.Number <> 0 Then
                            Sheets.Add After:=Sheets(Sheets.Count)
                            ActiveSheet.Name = lstFl(i)
                            l = 0
                        Else
                            aFl.Activate
                            l = aFl.Cells(aFl.Rows.Count, 1).End(xlUp).Row + IsEmpty(aFl.[A1])
                        End If
                        .AutoFilter Field:=nChp, Criteria1:=lstFl(i)
                        .Copy Destination:=ActiveSheet.[A1].Offset(l)
                        With ActiveSheet
                            .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp).Offset(0, plgChp.Count - 1)).RemoveDuplicates _
                                Columns:=Array(1, 2, 3, 4, 5), Header:=xlNo
                            .Move After:=Sheets(ThisWorkbook.Sheets.Count)
                        End With
                    Next
                End With
                plgChp.AutoFilter
                pFl.Activate
                With Application: .EnableEvents = 1: .Calculation = calcEtat: .ScreenUpdating = 1: End With
            End If
        End If
    End With
End Sub