Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier

[Chaton77]

Bonjour,

j'ai des fichiers de projets,
- 1 fichier "MenuPrincipal" (pour ouvrir des fichiers de contrôles)
- 1 fichier "Zone0Fiche" (pour faire un contrôle)

Dans chaque fichier de contrôle (zone 0 à 4), j'ai un tableau qui liste les contrôles faits (=Résultats)
Et je souhaite transférer chaque liste pour les regrouper au fichier principal ("MenuPrincipal")

Le transfert marche mais :
*au niveau du code j'ai une marque jaune au niveau : Date_Evaluation = Sheets ("Résultats").Range ("A" & i). Value
*le tableau de destination : les autres contrôles faits ne sont pas transférés seul le premier contrôle qui est transféré.

CF. PJ, le code est dans la fiche "Zone0" (pour le moment, mon travail se concentre dedans)

Si quelqu'un pourra m'aider sur ce point, svp.

Merci à l'avance
____________________________________________________________________
ci-après le code :

Option Explicit
Option Private Module

Sub TransfertSaisies()

'pour transférer les résultats dans le classeur de menus
'--------------------------------------------------------

'pour éviter le flash d'écran
Application.ScreenUpdating = False

'définir les fichier source, de destination
'-------------------------------------------------------
Dim monfichier As String
monfichier = ThisWorkbook.Name

Dim fichier_destination As String
fichier_destination = "MenuPrincipal.xlsm"

'définir et ouvrir le chemin où se trouve le fichier de destination
'activer le fichier source
'--------------------------------------------------------------------
Dim chemin As String
chemin = ThisWorkbook.Path & "\" & "fichier_destination"
'Workbooks.Open chemin
Workbooks(monfichier).Activate

'définir les variables
'---------------------------------------------------------------
Dim L As Long
L = Sheets("Résultats").Range("A1048576").End(xlUp).Row

Dim Date_Evaluation As String
Dim Secteur As String
Dim LocalVar As String
Dim Zone As String
Dim Statut As String
Dim Résultat As Double
Dim i As Long

'définir les données sources et leurs emplacements
'-----------------------------------------------------
For i = 2 To L

Date_Evaluation = Sheets("Résultats").Range("A" & i).Value
Secteur = Sheets("Résultats").Range("B" & i).Value
LocalVar = Sheets("Résultats").Range("C" & i).Value
Zone = Sheets("Résultats").Range("D" & i).Value
Résultat = Sheets("Résultats").Range("E" & i).Value
Statut = Sheets("Résultats").Range("F" & i).Value

'activer-choisir le fichier, feuille de destination
'définir les données, emplacements
'---------------------------------------------------
Workbooks(fichier_destination).Activate
Sheets("ListeControles").Select

Dim L2 As Long
L2 = Sheets("ListeControles").Range("A1048576").End(xlUp).Row + 1

Sheets("ListeControles").Range("A" & L2) = Date_Evaluation
Sheets("ListeControles").Range("B" & L2) = Secteur
Sheets("ListeControles").Range("C" & L2) = LocalVar
Sheets("ListeControles").Range("D" & L2) = Zone
Sheets("ListeControles").Range("E" & L2) = Résultat
Sheets("ListeControles").Range("F" & L2) = Statut

Next i

Workbooks(fichier_destination).Activate
Workbooks(monfichier).Activate

Application.ScreenUpdating = True

MsgBox "Les données sont transférées + vbinformation"

End Sub

 

[vgendron]

Bonjour

elle est ou la macro TransfertSaisies ?

 

[vgendron]

vu
à la deuxième itération du for i=2 to L, tu n'es plus dans le bon classeur

vu que tu copies colles toutes les colonnes au meme endroit d'un fichier vers l'autre.. pas besoin de boucle

ub TransfertSaisies()
    Dim ZoneToCopy As Range
    'pour transférer les résultats dans le classur dee menus
    '--------------------------------------------------------
                
    'pour éviter le flash d'écran
    Application.ScreenUpdating = False
                
    'définir les fichier source, de destination
    '-------------------------------------------------------
    Dim monfichier As String
    monfichier = ThisWorkbook.Name
                
    Dim fichier_destination As String
    fichier_destination = "MenuPrincipal.xlsm"
                
    'définir et ouvrir le chemin où se trouve le fichier de destination
    'activer le fichier source
    '--------------------------------------------------------------------
    Dim chemin As String
    chemin = ThisWorkbook.Path & "\" & "fichier_destination"
    'Workbooks.Open chemin
    Workbooks(monfichier).Activate
                
    'définir les variables
    '---------------------------------------------------------------
    Dim L As Long
    L = Sheets("Résultats").Range("A" & Rows.Count).End(xlUp).Row
                
    Dim Date_Evaluation As String
    Dim Secteur As String
    Dim LocalVar As String
    Dim Zone As String
    Dim Statut As String
    Dim Résultat As Double
    Dim i As Long
                
    'définir les données sources et leurs emplacements
    '-----------------------------------------------------
    Set ZoneToCopy = ActiveSheet.Range("A2:F" & L)
    
'    For i = 2 To L
'
'        Date_Evaluation = Sheets("Résultats").Range("A" & i).Value
'        Secteur = Sheets("Résultats").Range("B" & i).Value
'        LocalVar = Sheets("Résultats").Range("C" & i).Value
'        Zone = Sheets("Résultats").Range("D" & i).Value
'        Résultat = Sheets("Résultats").Range("E" & i).Value
'        Statut = Sheets("Résultats").Range("F" & i).Value
'
'        'activer-choisir le fichier, feuille de destination
'        'définir les données, emplacements
'        '---------------------------------------------------
        Workbooks(fichier_destination).Activate
        Sheets("ListeControles").Select

        Dim L2 As Long
        L2 = Sheets("ListeControles").Range("A1048576").End(xlUp).Row + 1
        ZoneToCopy.Copy Destination:=Sheets("ListeControles").Range("A" & L2)
'
'        Sheets("ListeControles").Range("A" & L2) = Date_Evaluation
'        Sheets("ListeControles").Range("B" & L2) = Secteur
'        Sheets("ListeControles").Range("C" & L2) = LocalVar
'        Sheets("ListeControles").Range("D" & L2) = Zone
'        Sheets("ListeControles").Range("E" & L2) = Résultat
'        Sheets("ListeControles").Range("F" & L2) = Statut
'
'    Next i
                
        Workbooks(fichier_destination).Activate
        Workbooks(monfichier).Activate
                    
        Application.ScreenUpdating = True
                    
        MsgBox "Les données sont transférées + vbinformation"
 
End Sub

 

[vgendron]

à noter.. pour "compiler" tes 4 fiches de zones vers le fichier principal, tu aurais tout intérêt à passer par PowerQuery

 

[Chaton77]

Bonsoir,
merci pour ton aide. Je vais regarder tout de nouveau.
A+

 

[Chaton77]

vgendron,
le code fonctionne.
Merci pour l'aide
Je vais voir pour la suite de mon travail et voir selon ton conseil PowerQuery
A+

 

[vgendron]

Pour PowerQuery

voir la requete dans la PJ
il suffit que les fichiers Zone soient dans le meme répertoire
et que chacun aie une table Structurée "t_Résultats"

un clic droit /actualiser, et hop.. tu récupères tous les résultats

 

[Chaton77]

Bonjour vgendron,
Merci pour ton aide.
C'est plus simple comme solution mais il faut que j'arrive à bien maîtriser le PowerQuery.
A+