Microsoft 365 automatiser macro pour copier/coller des données d´un classeur à un autre et sauver à chaque fois le classeur rempli

sevenkingdom · 26 Juillet 2020

Bonjour,

Je dispose d´un tableau 579 colonnes *12 lignes avec des données à transférer dans un tableau d´un autre classeur.
Chaque colonne du 1er tableau a des valeurs différentes à transférer à chaque fois dans les mêmes cellules du second classeur ´test bestiaire.
Appliqué à une seule colonne B, j´obtiens une macro moche du type

Sub test()
Workbooks("test bestiaire.xlsm").Worksheets("Feuil1").Range("B2").Value = Workbooks("bestiaire.xlsm").Worksheets("Feuil1").Range("B1").Value
Workbooks("test bestiaire.xlsm").Worksheets("Feuil1").Range("D1015").Value = Workbooks("bestiaire.xlsm").Worksheets("Feuil1").Range("B2:B7").Value
Workbooks("test bestiaire.xlsm").Worksheets("Feuil1").Range("G40").Value = Workbooks("bestiaire.xlsm").Worksheets("Feuil1").Range("B8").Value
Workbooks("test bestiaire.xlsm").Worksheets("Feuil1").Range("G38").Value = Workbooks("bestiaire.xlsm").Worksheets("Feuil1").Range("B9").Value
Workbooks("test bestiaire.xlsm").Worksheets("Feuil1").Range("G41:G43").Value = Workbooks("bestiaire.xlsm").Worksheets("Feuil1").Range("B10:B12").Value
End Sub

Je copie les cellules B1 à B12 de mon 1er classeur vers les cellules de mon second classeur.

Je voudrais automatiser cette macro pour les 578 colonnes restantes et obtenir au final 579 tableaux (579 fichiers avec comme nom, les intitulés de la ligne 1, et en csv)

J´ai également ¨cassé¨ mon tableau 1 en 579 fichiers xls (format identique pour tous, 2 colonnes 12 lignes, mais ce coup ci toutes les données à copier sont dans la colonne B1:B12 de chaque fichier) pour appliquer cette macro, mais le problème est décalé (comment appliquer alors 1 macro à 579 fichiers différents??)

J´avais fait cette macro adaptée d´une macro trouvée sur un site

Sub test()
Dim i&, TTmp As Variant, Tdate As Variant, Tst$
Dim F As Worksheet, D As Object
Set D = CreateObject("Scripting.dictionary")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sheets("Feuil1")
Tdate = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(3))
For i = 2 To .Cells(2, .Columns.Count).End(1).Column Step 1
TTmp = .Range(.Cells(1, i), .Cells(UBound(Tdate, 1), i + 0))
On Error Resume Next
Tst = Replace(TTmp(1, 1), "/", "-")
Tst = Left(Tst, 30)
Set F = Sheets(Tst)
If Err Then
Err.Clear
Sheets.Add(After:=Sheets(Sheets.Count)).Name = Tst
D(TTmp(1, 1)) = ""
Set F = Sheets(Tst)
End If
If Not D.exists(F.Name) Then
F.Range(F.Cells(1, 1), F.Cells(F.Rows.Count, 1).End(3)(1, 6)).ClearContents
D(F.Name) = ""
End If
F.Cells(1, 1).Resize(UBound(Tdate, 1), 1) = Tdate
F.Cells(1, 2).Resize(UBound(Tdate, 1)) = TTmp
F.Columns.AutoFit
F.Move

Workbooks("test bestiaire.xlsm").Worksheets("Feuil1").Range("B2").Value = Workbooks("bestiaire.xlsm").Worksheets("Feuil1").Range("B1").Value
Workbooks("test bestiaire.xlsm").Worksheets("Feuil1").Range("D1015").Value = Workbooks("bestiaire.xlsm").Worksheets("Feuil1").Range("B2:B7").Value
Workbooks("test bestiaire.xlsm").Worksheets("Feuil1").Range("G48").Value = Workbooks("bestiaire.xlsm").Worksheets("Feuil1").Range("B8").Value
Workbooks("test bestiaire.xlsm").Worksheets("Feuil1").Range("G46").Value = Workbooks("bestiaire.xlsm").Worksheets("Feuil1").Range("B9").Value
Workbooks("test bestiaire.xlsm").Worksheets("Feuil1").Range("G49:G51").Value = Workbooks("bestiaire.xlsm").Worksheets("Feuil1").Range("B10:B12").Value

ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Format(Date, "dd_mm_yyyy") & "_" & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close False
Err.Clear
Next i
.Activate
End With
Application.DisplayAlerts = True
End Sub

Elle m a permis de séparer mon 1er classeur en 579 fichiers .csv mais ,évidemment, seules les données de la colonne B ont été copiées dans le classeur 2.

Donc comment faire pour transférer les données de B1:B12 du classeur 1 sur les bonnes cellules du classeur 2 puis sauver (en csv avec le nom de B1) le classeur 2 rempli , et recommencer la même opération avec C1:C12 , puis D112 etc

En espérant que vous pourrez m´aider.

sylvanu · 26 Juillet 2020

Essayez ça si j'ai bien compris la problématique.
J'ai rajouté la mesure de temps car avec plus de 500 fichiers, l'utilisateur va devoir patienter.

sylvanu · 26 Juillet 2020

Bonjour Sevenkingdom, et bienvenu sur XLD,
( utilisez les balises </> pour le code, c'est bien plus lisible )
Vous pouvez construire une macro de transfert comme celle ci dessous :

VB:

Sub TransfertDonnées(Colonne As Integer)     ' C numéro de colonne à transferer
' tranfert des données de bestiaire.xlsm de Colonne vers test bestiaire.xlsm
    Set WF = Workbooks("test bestiaire.xlsm").Worksheets("Feuil1")
    Set RF = Workbooks("bestiaire.xlsm").Worksheets("Feuil1")
    WF.Range("B2").Value = RF.Cells(1, Colonne)
    WF.Range("G48").Value = RF.Cells(8, Colonne)
    WF.Range("G46").Value = RF.Cells(9, Colonne)
    WF.Range("D10:D15").Value = RF.Range(Cells(2, Colonne), Cells(7, Colonne)).Value
    WF.Range("G49:G51").Value = RF.Range(Cells(10, Colonne), Cells(12, Colonne)).Value
End Sub

L'appel dans le module principal se fait de cette façon :

Code:

Sub Essai()
Dim C As Integer
For C = 2 To 579    ' Pour les colonnes de 2 à 579
' Preparer fichier
' .....
' Transferer données
    TransfertDonnées C  ' On lance le transfert de la colonne C
' Enregistrer csv
' ...
Next C
End Sub

dans le module principal il faut gérer la colonne à transferer, puis faire appel à la macro de transfert.
c'est une méthode simple et robuste.

sevenkingdom · 26 Juillet 2020

Bonjour. Merci pour la réponse.
Mais, si je comprends bien la 1ere macro, je ne comprends pas la suite. Où placer la macro sub transfertdonnées dans sub essai()? Ce sont deux macros différentes ?

Les éléments qui suivent ' sont explicatifs et pas à copier dans la macro ?

sylvanu · 26 Juillet 2020

Elle set appelée ici :

VB:

' Transferer données
    TransfertDonnées C  ' On lance le transfert de la colonne C

En fait j'aurais pu l'écrire :

Code:

' Transferer données
    Call TransfertDonnées (C)  ' On lance le transfert de la colonne C

mais je suis fainéant et ça alourdit la lecture inutilement

sevenkingdom · 26 Juillet 2020

Bonjour
J ai essayé et il y a sûrement quelque chose que je fais mal. Je suis novice en langage VBA. j ai bien obtenu le transfert de la colonne B de bestiaire.xlsm sur l´autre classeur mais, pour le reste, j ai juste obtenu un fichier 26_07_2020_Feuil1.csv contenant mon fichier bestiaire en .csv ... et maintenant je n obtiens même plus rien...

j ai entré cela et j obtiens un message d erreur ...

VB:

Sub TransfertDonnées(Colonne As Integer)     ' C numéro de colonne à transferer
' tranfert des données de bestiaire.xlsm de Colonne vers test bestiaire.xlsm
    Set WF = Workbooks("test bestiaire.xlsm").Worksheets("Feuil1")
    Set RF = Workbooks("bestiaire.xlsm").Worksheets("Feuil1")
    WF.Range("B2").Value = RF.Cells(1, Colonne)
    WF.Range("G48").Value = RF.Cells(8, Colonne)
    WF.Range("G46").Value = RF.Cells(9, Colonne)
    WF.Range("D10:D15").Value = RF.Range(Cells(2, Colonne), Cells(7, Colonne)).Value
    WF.Range("G49:G51").Value = RF.Range(Cells(10, Colonne), Cells(12, Colonne)).Value
End Sub

Sub Essai()
Dim C As Integer
For C = 2 To 579
Call TransfertDonnées(C)

ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Format(Date, "dd_mm_yyyy") & "_" & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
            ActiveWorkbook.Close False
            Err.Clear
    
      
Next C
End Sub

sylvanu · 26 Juillet 2020

Bonjour,
Dans votre code les fichiers sauvegardés portent toujours le même nom ?
En PJ un essai.
Je ne sauvegarde que 10 fichiers ( à modifier )
J'écrase le fichier s'il existe déjà, peut être modifié.

sevenkingdom · 26 Juillet 2020

Ca fonctionne (vous n´en doutiez pas) et merci mille fois. En plus il y a des explications et cela permet de comprendre ce qui se passe!

Mais il faudrait 2 améliorations.

que le nom du fichier créé correspondent au nom de la cellule 1 (B1 C1 du bestiaire etc) ou à celui de la cellule B2 du fichier créé.

que le fichier soit enregistré en csv sans colonne

Si je remplace

Code:

SaveAs Filename:=ThisWorkbook.Path & "\" & Format(Date, "dd_mm_yyyy") & "_" & ActiveSheet.Name & "_" & C & ".csv"

par
,

VB:

SaveAs ThisWorkbook.Path & "\" & Format(Date, "dd_mm_yyyy") & "_" & ActiveSheet.Name & ".csv", FileFormat:=xlCSV,

Encore merci!

sylvanu · 26 Juillet 2020

Essayez ça si j'ai bien compris la problématique.
J'ai rajouté la mesure de temps car avec plus de 500 fichiers, l'utilisateur va devoir patienter.

sevenkingdom · 26 Juillet 2020

Cela a fonctionné !! J ai enlevé la date et feuil1 pour ne garder que le nom. Merci beaucoup !

Microsoft 365 automatiser macro pour copier/coller des données d´un classeur à un autre et sauver à chaque fois le classeur rempli

sevenkingdom

XLDnaute Nouveau

sylvanu

sylvanu

XLDnaute Barbatruc

sevenkingdom

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

sevenkingdom

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Pièces jointes

sevenkingdom

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Pièces jointes

sevenkingdom

XLDnaute Nouveau

Discussions similaires