Récupération données fichier source VBA

Merci infiniment pour votre aide Thauthème, c'est formidable ! J'ai beaucoup appris grâce à vous, et je crois que ce topic intéressera pas mal de personnes sur ce site !

Bonjour Thauthème & tous,

J'aurais juste une dernière question concernant ce topic. Je souhaiterais que le clear dans mon fichier destination ne se fasse uniquement jusqu'à la 4ème colonne par exemple et non sur toute la ligne de ma feuille, car je conserve des données en dur à partir de la 5ème colonne qui ne changent jamais.

OD.Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'efface les anciennes valeurs de l'onglet OD
'renvoie dans A2 redimensionnée de l'onglet OD le tableau TL transposé

Merci de votre retour.

Bonjour Gupette, bonjour le forum,

Ce qui serait bien c'est que tu renvoies (avec les balises </>)le code complet que tu utilises actuellement car il a été pas mal modifié depuis le temps et on est obliger de relire les ancien post pour savoir où on en est.

Essaie comme ça :

Dim DL As Integer 'déclare la variable DL (Derniere Ligne) cette ligne est à placer en début de code dans la partie déclaration des variables en dernier (ce n'est pas obligatoire mais au moins toutes les déclarations seront en debut de code)

If K > 0 Then 'condition : si K est supérieure à zéro
    DL = OD.Cells(Application.Rows.Count, "E").End(xlUp).Row 'définit la dernière ligne éditée de la colonne E de l'onglet OD
    OD.Range("A1:D" & DL).ClearContents 'efface le contenu de la plage A1:D... (& DL)
    OD.Cells(DL + 1, "A").Resize(K, 6).Value = Application.Transpose(TL) 'renvoie le tableau structuré dans la cellule ligne DL + 1 , colonne A de l'onglet OD
End If

Re Thauthème,

Votre aide m'a permis de répondre à mon problème, encore merci ! Je ne suis pas familier avec l'usage des balises, comment faire pour envoyer pour les autres présents sur ce forum, le code sous un format plus agréable comme vous le faîtes actuellement ?

Re,

Tu as en haut de ton message, quand tu l'écris, une série de symboles. Si tu cliques sur le 15ème, en partant de la gauche (</>), la boite Code s'ouvre. Colle ton code à l'intérieur de celle-ci puis valide avec le bouton Insérer...

Sub Import()

Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim MemFic As String 'déclare la variable MemFic
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim F As String 'déclare la variable F (Fichier)
Dim FMax As String 'déclare la variable FMax (Fichier Max)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim DL As Integer

Application.ScreenUpdating = False
Set CD = ThisWorkbook
Set OD = CD.Worksheets(1)
CA = "\" 'emplacement du dossier à définir avec \ à la fin
F = Dir(CA & "xx" & "????????" & "aa.xls") 'définit le premier classeur F commençant par xx suivi de 8 caractères variables et ayant CA comme chemin d'accès
Do While F <> "" 'boucle tant qu'il existe un fichier F
    'si le texte à partir du 3ème caractère de F est supérieur à MemFic alors Memfic devient ce texte et le fichier FMax devient F
    If Mid(F, 3) > MemFic Then MemFic = Mid(F, 3): FMax = F
    F = Dir 'définit le prochain fichier F ayant les mêmes caractéristiques et ayant CA comme chemin D'accès
Loop 'boucle
Set CS = Workbooks.Open(CA & FMax)
Set OS = CS.Worksheets(1)
TV = OS.Range("A4").CurrentRegion
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 11) = "A" Or TV(I, 11) = "B" Then   'condition : si la donnée ligne I colonne 4 de TV est égale à A ou B
        K = K + 1 'incrémente K

        ReDim Preserve TL(1 To 4, 1 To K) 'redimensionne le tableau des lignes TL (2 lignes, K colonnes)
        TL(1, K) = IIf(TV(I, 1) = "critère", "texte1" & TV(I, 2), "texte2" & TV(I, 2))
        TL(2, K) = TV(I, 6)
        TL(3, K) = TV(I, 8)
        TL(4, K) = TV(I, 7)

        'Next J 'prochaine colonne de la boucle 2
    End If
Next I 'prochaine ligne de la boucle 1
' CS.Close False 'ferme le classeur source sans enregistrer
If K > 0 Then 'condition : si K est supérieure à zéro
    DL = OD.Cells(Application.Rows.Count, "E").End(xlUp).Row 'définit la dernière ligne éditée de la colonne E de l'onglet OD
    OD.Range("A6:D" & DL).ClearContents 'efface le contenu de la plage A1:D... (& DL)
    OD.Range("A6").Resize(K, 4).Value = Application.Transpose(TL) 'renvoie le tableau structuré dans la cellule ligne DL + 1 , colonne A de l'onglet OD
End If
'CD.Save
OD.Activate
Application.ScreenUpdating = True
End Sub

Bonjour, voici le code définitif utilisé. Dans un souci de confidentialité j'ai enlevé chemin d'accès et mis des critères lambdas. Merci encore pour votre aide Thauthème à bientôt sur le forum !