Exportation données tableau d'un classeur à un autre

Bonsoir à tous,

Je suis encore au boulot à m’arracher les cheveux pour trouver une solution à mon problème.

Quelqu’un peut’ il me sauver mon weekend ?

Je cherche à exporter plusieurs lignes d’un tableau dont le nombre indiqué en A1 est variable.

Vers un autre fichier, à la suite des lignes pleines d’un tableau en feuille (1).

Pour cela j’utilise un code qui marche très bien dans un même classeur mais pas entre deux classeurs différents.

Pour plus de compréhension, je joins deux fichiers, le donnant (classeur1) et le receveur (classeur2)

Merci de votre aide

Bonne soirée

Voici le code :

Sub export()

Dim User As Workbook, Applicant As Workbook
Dim Rep As Integer
Set User = ThisWorkbook
On Error GoTo errorHandler
NomfichierApplicant = Application.GetOpenFilename
' On verifie que l'on a selectionné un nom de classeur
If NomfichierApplicant <> False Then
' On ouvre le classeur
Set Applicant = Workbooks.Open(NomfichierApplicant)
' Verifie si c'est bien le bon TSA
End If

Rep = MsgBox("Is it the right TSA?", vbYesNo + vbQuestion, "Update Process")
If Rep = vbNo Then
Applicant.Close False 'ferme et n'enregistre pas le classeur Applicant
Exit Sub
Else

Dim x As Integer
Dim L As Integer

User.Activate

For x = 3 To User.Sheets("Feuil1").Range("A1").Value + 3
L = Applicant.Sheets(1).Range("D3:D" & Applicant.Sheets(1).[D65000].End(xlUp).Row) + 1 'Pour placer le nouvel enregistrement à la première ligne de tableau non vide

        Applicant.Sheets(1).Range("D" & L).Value = User.Sheets("Feuil1").Cells(x, 1)
        Applicant.Sheets(1).Range("E" & L).Value = User.Sheets("Feuil1").Cells(x, 2)
        Applicant.Sheets(1).Range("F" & L).Value = User.Sheets("Feuil1").Cells(x, 3)
Next x
End If

errorHandler:
End Sub

Bonsoir,

A tester dans ton environnement.

Cdlt.

Option Explicit
Option Private Module
Public Sub export()
Dim wbSource As Workbook, wbTarget As Workbook
Dim sTarget As Variant
Dim Response As Integer
Dim rowTarget As Long, rowSource As Integer
Dim rng As Range

    sTarget = Application.GetOpenFilename
    If sTarget <> False Then
        Set wbTarget = Workbooks.Open(sTarget)
    Else
        Exit Sub
    End If

    On Error GoTo exitHandler
    Application.ScreenUpdating = False
    Set wbSource = ThisWorkbook
    Response = MsgBox("Is it the right TSA?", vbYesNo + vbQuestion, "Update Process")
    If Response = vbNo Then
        wbTarget.Close False
        GoTo exitHandler
    Else
        rowTarget = Worksheets("Feuil1").Cells(Rows.Count, "D").End(xlUp).Row + 1
        With wbSource.Worksheets("Feuil1")
            rowSource = .Cells(Rows.Count, "A").End(xlUp).Row
            Set rng = .Range("A4:C" & rowSource)
            rng.Copy Destination:=Range("D" & rowTarget)
            Application.CutCopyMode = False
        End With
        With wbTarget
            .Save
            .Close False
            MsgBox "la mise à jour s'est effectuée correctement", vbInformation
        End With
    End If
    Set rng = Nothing

exitHandler:
    Set wbTarget = Nothing: Set wbSource = Nothing
    Exit Sub

End Sub

Oh merci Jean-Eric, c'est super, ça marche nickel. Merci d'avoir pris de ton temps pour m'aider.

Maintenant je vais essayer d'adapter cela à des fichiers beaucoup plus volumineux.

Bon weekend à tous.