Copie plage de cellule présente dans plusieurs fichiers vers autre fichier

Bonjour,

Tout d’abord je tiens à m'excusez pour le semi-plagia du titre ainsi que pour la syntaxe ( manque de place).

J'ai recherché dans plusieurs poste mon besoin sans le trouver ou pouvoir l'exploiter.

Je vais essayer de vous expliquer ce que je recherche à faire .

J'ai dans un fichier des données situées toujours au même emplacement : Appelons le "fichier1"

Et dans un second temps un fichier ou je voudrais regrouper les données de "fichier1" ( Appelons le "registre") au même emplacement.

J'ai donc réussi à trouver un de vos post discutant du même problème (Problématique résolu: https://forum.excel-pratique.com/viewtopic.php?t=33648 )

La troisième chose que je voudrais ajouter : un ajout de données de "fichier1" vers "registre" dans la ligne ou les cellules sont vides puisqu'il peut déjà y avoir des données présente dans les cellules de réception .

Donc lors le l'importation des données de "fichier1" vers "registre" je voudrais qu'il recherche les cellules( lignes) vides avant de copier les données : puis qu'il colle les données dans ses cellules (vide)

De plus , avant toute importation je voudrais qu'il recherche aussi si dans la colonne "A" ("registre") si il retrouve la même donnée que dans "A2"("fichier1") : Si oui qu'il écrase ses données par les nouvelles.

Je sais pas si vous aller bien comprendre se que je raconte , je m'en excuse d'avance sinon.

J'ai fait de multiple recherche sans aboutir de part ma formation très novice avec VBA.

Vous remercie d'avance ...

Bonsoir,

On se contente généralement de quelques lignes de données... mais là avec une ligne, seule et identique sur les deux fichiers, tu ne nous fournis pas vraiment de quoi tester ! C'est donc toi qui testera...

Sub TftRegistre()
    Dim Rgt As Workbook, d As Object, n&, i&, k%, Ttft
    Set d = CreateObject("Scripting.Dictionary")
    With ThisWorkbook.Worksheets(1)
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        k = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For i = 2 To n
            d(.Cells(i, 1).Value) = ""
        Next i
        Ttft = .Range("A2").Resize(n - 1, k).Value
    End With
    Set Rgt = Workbooks.Open(ThisWorkbook.Path & "\registre.xlsx")
    With Rgt.Worksheets(1)
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            If d.exists(.Cells(i, 1).Value) Then .Cells(i, 1).ClearContents
        Next i
        .Range("A2:A" & n - 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        n = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Range("A" & n).Resize(UBound(Ttft), k).Value = Ttft
    End With
    Rgt.Close True
End Sub

Cordialement.

Bonjour,

je te remercie pour ta réponse .... mais étant novice je n'y comprend pas grand chose .

Avec mes recherche j'ai réussi à avancé un peu mais en restant bloqué ....

Peut tu me dire si je suis sur la bonne route ?

Merci....

Sub copie_vers_registre()
Dim fichier1 As Workbook, y As Range, z As Range ', v As String

  Set registre = Application.Workbooks.Open("C:\Users\conta\Desktop\internet\registre", True)

  Dim x%
  Application.ScreenUpdating = False

  x = registre.Worksheets("Feuil1").Cells(65535, 1).End(xlUp)(2).Row
  Set y = registre.Worksheets("Feuil1").Range("A2:A1000").Find(What:=Range("A2"), LookAt:=xlWhole)

 If y Is Nothing Then

  Else
    With ThisWorkbook.Worksheets("Feuil1").Range("A2:F2")

    .Copy registre.Worksheets("Feuil1").Cells(y, 1)
  End With
  End If
  Set y = Nothing

  Application.ScreenUpdating = True

  registre.Save

End Sub

Je fournis une procédure répondant à ta demande, tu la testes, et on verra la suite après !

Je vais essayer de la comprendre , je te remercie de ton investissement .

Comprendre est une chose tester une autre !

J'ai demandé que tu testes, dans les conditions initialement indiquées. Il sera toujours temps ensuite de t'expliquer comment ça fonctionne.

Cordialement.