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

S

sevenkingdom

XLDnaute Nouveau
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("D10:D15").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("D10:D15").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 D1:D12 etc

En espérant que vous pourrez m´aider.
 
Trier par date Trier par votes
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
 
Vote positif 0 Vote négatif
S

sevenkingdom

XLDnaute Nouveau
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 ?
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
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
 
Vote positif 0 Vote négatif
S

sevenkingdom

XLDnaute Nouveau
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
 
Vote positif 0 Vote négatif
S

sevenkingdom

XLDnaute Nouveau
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!
 
Vote positif 0 Vote négatif

Discussions similaires

Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
404
Chaton77
Chaton77
medlight
  • Question
Autres Transfert des données d'un classeur à un autre
Réponses
5
Affichages
550
Oneida
Oneida
G
  • Question
Microsoft 365 Avoir des classeurs maitres et les procédures dans un autre classeur.
2
Réponses
18
Affichages
1 K
GClaire
G
A
  • Question
Microsoft 365 Cpier/coller en VBA
Réponses
7
Affichages
613
A-F
A
F
  • Question
Microsoft 365 Copier un dossier et son contenu puis y enregistrer un classeur. Renommer chaque élément selon des valeurs de cellules
Réponses
1
Affichages
712
Zon
Z
C
  • Résolu(e)
XL 2019 Copier et renommer (en même temps) des feuilles à partir d'une liste de noms dans un colonne
Réponses
13
Affichages
1 K
Clemee61
C
A
  • Question
Microsoft 365 Copier/coller un plusieurs lignes
Réponses
5
Affichages
736
LeSaintKebab
L
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
526
robpellan52
R
K
  • Résolu(e)
XL 2019 Copier Seulement les lignes affichée après un filtre de tableau
Réponses
9
Affichages
2 K
Kushi
K
K
  • Résolu(e)
Microsoft 365 Ouvrir un autre classeur excel (VBA) pour utiliser les données de celui dans le classeur actif
Réponses
5
Affichages
1 K
Dranreb
Dranreb

Membres actuellement en ligne

6 membres et 114 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 089
Messages
2 116 099
Membres
112 661
dernier inscrit
ceucri