Transfert de données classeur vers autre classeur

Le 28/08/2020 à 21:07

Bonjour,

Je sollicite votre aide. Il faut que je transfère des données d'un classeur vers un autre classeur, pour cela je me suis servi de l'enregistreur de macro.
Voir fichier

Je pense qu'il y a possibilité de faire plus simple avec une boucle mais je ne sais pas comment procéder. Merci

32transfert-donnees.xlsm (27.65 Ko)
Le 29/08/2020 à 00:52

Bonjour,

Voici un code qui simplifierait les choses, à condition toutefois de respecter une logique, à savoir respecter un écart précis entre chaque plage de destination (ici normalement 12).

Il arrive qu'il y ait un décalage. Donc je suis parti du principe qu'on commence (sur l'onglet de destination) en E2, G2 et K7. Ensuite, on va toujours de 12 en 12.

Option Base 1

Sub TransfertDonnees()

Dim WbOrigine As Workbook, WbDest As Workbook 'variables classeur
Dim WsDest As Worksheet, WSO As Worksheet 'variables onglet
Dim ExportUn(10, 2), ExportDeux(10), ExportTrois(2) 'variables tableau pour transport donnees
Dim N% 'variable d'incrémentation

Set WbOrigine = ThisWorkbook 'le classeur d'origine où sont censées se trouver les macros
Set WbDest = Workbooks("07 2020 Reporting FLVs..xlsm") 'classeur destination >>> Préférer ce genre de nom de fichier "Reporting FLV 2007.xlsm"
Set WsDest = WbDest.Sheets("Données") 'onglet destination

Workbooks.Open WbDest.Name 'ouverture du classeur reporting

For Each WSO In WbOrigine.Worksheets 'pour chaque feuille du classeur d'origine

    If Left(WSO.Name, 3) = "FLV" Then 'si le nom d'onglet commence par FLV

    With WSO 'sur l'onglet en cours > on prend les valeurs à extraire sur nos trois tableaux
        ExportUn.Value = .Range("G3:G12,I3:I12")
        ExportDeux.Value = .Range("h3:h12")
        ExportTrois.Value = .Range("j2:K2")
    End With

    With WsDest 'sur l'onglet de destination > on colle les valeurs de nos trois tableaux
        .Range("E" & 2 + 12 * N & ":F" & 11 + 12 * N).Value = ExportUn
        .Range("G" & 2 + 12 * N & ":G" & 11 + 12 * N).Value = ExportDeux
        .Range("K" & 7 + 12 * N & ":L" & 7 + 12 * N).Value = ExportTrois
    End With

    N = N + 1 'incrémentation de N

    End If

Next WSO 'nouvel onglet à examiner

'WbDest.Close savechanges:=True 'pour fermer directement en sauvant les modifs

Set WsDest = Nothing 'libération variables
Set WbDest = Nothing
Set WbOrigine = Nothing

End Sub

Il est possible que ça ne marche pas du premier coup mais vous ne serez pas loin du résultat final attendu.

Cordialement,

Le 29/08/2020 à 09:41

Bonjour 3GB, merci pour tout les commentaires que tu mets. Cela aide à la compréhension.
Lorsque j'ai voulu faire un essai ce message d'erreur est apparu

image
Le 29/08/2020 à 10:02

Salut Christian,

Oui, c'est dû à une erreur de syntaxe de ma part, dans la précipitation. Peux-tu essayer ainsi :

Option Base 1

Sub TransfertDonnees()

Dim WbOrigine As Workbook, WbDest As Workbook 'variables classeur
Dim WsDest As Worksheet, WSO As Worksheet 'variables onglet
Dim ExportUn(10, 2), ExportDeux(10), ExportTrois(2) 'variables tableau pour transport donnees
Dim N% 'variable d'incrémentation

Set WbOrigine = ThisWorkbook 'le classeur d'origine où sont censées se trouver les macros
Set WbDest = Workbooks("07 2020 Reporting FLVs..xlsm") 'classeur destination >>> Préférer ce genre de nom de fichier "Reporting FLV 2007.xlsm"
Set WsDest = WbDest.Sheets("Données") 'onglet destination

Workbooks.Open WbDest.Name 'ouverture du classeur reporting

For Each WSO In WbOrigine.Worksheets 'pour chaque feuille du classeur d'origine

    If Left(WSO.Name, 3) = "FLV" Then 'si le nom d'onglet commence par FLV

    With WSO 'sur l'onglet en cours > on prend les valeurs à extraire sur nos trois tableaux
        ExportUn = .Range("G3:G12,I3:I12").value
        ExportDeux = .Range("h3:h12").value
        ExportTrois = .Range("j2:K2").value
    End With

    With WsDest 'sur l'onglet de destination > on colle les valeurs de nos trois tableaux
        .Range("E" & 2 + 12 * N & ":F" & 11 + 12 * N).Value = ExportUn
        .Range("G" & 2 + 12 * N & ":G" & 11 + 12 * N).Value = ExportDeux
        .Range("K" & 7 + 12 * N & ":L" & 7 + 12 * N).Value = ExportTrois
    End With

    N = N + 1 'incrémentation de N

    End If

Next WSO 'nouvel onglet à examiner

'WbDest.Close savechanges:=True 'pour fermer directement en sauvant les modifs

Set WsDest = Nothing 'libération variables
Set WbDest = Nothing
Set WbOrigine = Nothing

End Sub
Le 29/08/2020 à 10:05

Et au cas où ça ne donnerait pas le résultat souhaité à cause de la discontinuité de la plage G3:G12, I3:I12, essaie ainsi :

Option Base 1

Sub TransfertDonnees()

Dim WbOrigine As Workbook, WbDest As Workbook 'variables classeur
Dim WsDest As Worksheet, WSO As Worksheet 'variables onglet
Dim ExportUn(10), Export1bis(10), ExportDeux(10), ExportTrois(2) 'variables tableau pour transport donnees
Dim N% 'variable d'incrémentation

Set WbOrigine = ThisWorkbook 'le classeur d'origine où sont censées se trouver les macros
Set WbDest = Workbooks("07 2020 Reporting FLVs..xlsm") 'classeur destination >>> Préférer ce genre de nom de fichier "Reporting FLV 2007.xlsm"
Set WsDest = WbDest.Sheets("Données") 'onglet destination

Workbooks.Open WbDest.Name 'ouverture du classeur reporting

For Each WSO In WbOrigine.Worksheets 'pour chaque feuille du classeur d'origine

    If Left(WSO.Name, 3) = "FLV" Then 'si le nom d'onglet commence par FLV

    With WSO 'sur l'onglet en cours > on prend les valeurs à extraire sur nos trois tableaux
        ExportUn = .Range("G3:G12").value
        Export1bis = .Range("I3:I12").value
        ExportDeux = .Range("h3:h12").value
        ExportTrois = .Range("j2:K2").value
    End With

    With WsDest 'sur l'onglet de destination > on colle les valeurs de nos trois tableaux
        .Range("E" & 2 + 12 * N & ":E" & 11 + 12 * N).Value = ExportUn
        .Range("F" & 2 + 12 * N & ":F" & 11 + 12 * N).Value = Export1bis
        .Range("G" & 2 + 12 * N & ":G" & 11 + 12 * N).Value = ExportDeux
        .Range("K" & 7 + 12 * N & ":L" & 7 + 12 * N).Value = ExportTrois
    End With

    N = N + 1 'incrémentation de N

    End If

Next WSO 'nouvel onglet à examiner

'WbDest.Close savechanges:=True 'pour fermer directement en sauvant les modifs

Set WsDest = Nothing 'libération variables
Set WbDest = Nothing
Set WbOrigine = Nothing

End Sub

Cdlt,

Le 29/08/2020 à 10:42

J'ai essayé les 2 méthodes à chaque fois j'ai le même message.

image
Le 29/08/2020 à 10:54

Je peux voir ce que ça donne avec le dernier essai ? Sinon, peux-tu essayer comme ça :

Option Base 1

Sub TransfertDonnees()

Dim WbOrigine As Workbook, WbDest As Workbook 'variables classeur
Dim WsDest As Worksheet, WSO As Worksheet 'variables onglet
Dim ExportUn(), Export1bis(), ExportDeux(), ExportTrois() 'variables tableau pour transport donnees
Dim N% 'variable d'incrémentation

Set WbOrigine = ThisWorkbook 'le classeur d'origine où sont censées se trouver les macros
Set WbDest = Workbooks("07 2020 Reporting FLVs..xlsm") 'classeur destination >>> Préférer ce genre de nom de fichier "Reporting FLV 2007.xlsm"
Set WsDest = WbDest.Sheets("Données") 'onglet destination

Workbooks.Open WbDest.Name 'ouverture du classeur reporting

For Each WSO In WbOrigine.Worksheets 'pour chaque feuille du classeur d'origine

    If Left(WSO.Name, 3) = "FLV" Then 'si le nom d'onglet commence par FLV

    With WSO 'sur l'onglet en cours > on prend les valeurs à extraire sur nos trois tableaux
        ExportUn = .Range("G3:G12").value
        Export1bis = .Range("I3:I12").value
        ExportDeux = .Range("h3:h12").value
        ExportTrois = .Range("j2:K2").value
    End With

    With WsDest 'sur l'onglet de destination > on colle les valeurs de nos trois tableaux
        .Range("E" & 2 + 12 * N & ":E" & 11 + 12 * N).Value = ExportUn
        .Range("F" & 2 + 12 * N & ":F" & 11 + 12 * N).Value = Export1bis
        .Range("G" & 2 + 12 * N & ":G" & 11 + 12 * N).Value = ExportDeux
        .Range("K" & 7 + 12 * N & ":L" & 7 + 12 * N).Value = ExportTrois
    End With

    N = N + 1 'incrémentation de N

    End If

Next WSO 'nouvel onglet à examiner

'WbDest.Close savechanges:=True 'pour fermer directement en sauvant les modifs

Set WsDest = Nothing 'libération variables
Set WbDest = Nothing
Set WbOrigine = Nothing

End Sub
Le 29/08/2020 à 12:03

Je me suis peut être mal exprimé, je veux prendre des données d'un classeur nommé Test macro vers un autre classeur que j'ai renommé classeur destination (j'ai suivi ton conseil) Les deux classeurs sont ouvert. Pour tester, j'ai lancé la macro depuis les 2 classeurs, rien n'y fait. Voici le résultat que tu m'as demandé

image

Pour le dernier essai,

image

Lorsque je clic sur débogage, voila le message. Le classeur demandé est dans le même dossier

image
Le 29/08/2020 à 12:06

Peux-tu essayer avec :

Set WbDest = Workbooks("classeur destination.xlsx")
Le 29/08/2020 à 12:10

J'ai très bien compris ce qu'il te fallait. Ici, c'est juste une question d'exactitude des valeurs à saisir. Si tu rencontres un échec, essaie de regarder l'extension (.xls, .xlsx, .xlsm) ou sinon de saisir le chemin complet.

Le 29/08/2020 à 12:11

Et si le classeur de destination est déjà ouvert, tu peux mettre la ligne workbooks.open en commentaire mais il faut quand même que notre variable WbDest corresponde bien à ce classeur...

Le 29/08/2020 à 12:20

En mettant la ligne workbooks.open en commentaire cela fonctionne parfaitement.

Merci, le code est allégé, et cela est plus simple

Le 29/08/2020 à 12:28

Et bah voilà !

J'ai eu l'impression que tu commençais à douter...

Bonne journée,

Le 29/08/2020 à 12:35

Non, du tout. Tu as été très patient. C'est plutôt en moi, certaine fois j'ai du mal à être clair.

Rechercher des sujets similaires à "transfert donnees classeur"