Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Copier les données d'un classeur coller vers un autre en fonction de la source

Nyepalo

XLDnaute Junior
Bonjour,

J’ai parcouru plusieurs anciennes discussions pas vraiment similaires dans le forum car mais mon problème a un détail de plus qui n'a pas été traité dans les autres discussions.

J’ai deux classeurs (nommées PI et PV) avec les données quotidiennes plus ou moins identiques.
J’ai un autre classeur d’archivage dans lequel je colle les données dans les onglets BU_PI et BU_PV selon que la source est PI ou PV puis j’ajoute la date de la copie au début de chaque nouvelle copie de données. Je joins mes fichiers tests.

L'algorithme ci-dessous :

  1. Classeur source, feuille « Data »
  2. Ouvre le classeur archivage
  3. Revenir au classeur source, feuille « Data »
  4. Sélectionne la plage des cellules puis copie des données,
  5. Va dans le classeur archivage,
  6. Choix de la feuille appropriée
  7. Si le nom du fichier source est PI alors,
  8. Va dans archivage
  9. Sélectionne la feuille BU_PI
  10. Place le curseur à la première ligne vide de la zone de copie
  11. Ecrit la date du jour dans la colonne date copie
  12. Copie les données en valeur
  13. Sinon
  14. Sélectionne la feuille BU_PV
  15. Place le curseur à la première ligne vide de la zone de copie
  16. Ecrit la date du jour dans la colonne date copie
  17. Copie les données en valeur
  18. Fin
  19. Enregistre et Ferme Archivage.xlsx
  20. Revenir au classeur source

Merci d'avance de votre précieuse aide.
 

Pièces jointes

  • BUDATA_VIR.xlsx
    10 KB · Affichages: 38
  • Test_BU.xlsm
    20.6 KB · Affichages: 29

Staple1600

XLDnaute Barbatruc
Re : Copier les données d'un classeur coller vers un autre en fonction de la source

Bonsoir à tous

Nyepalo
Testes cette version remaniée ta macro Archivage et reviens nous dire ce que cela donne chez toi
NB: il te faudra peut-être adapter le nom du classeur *.xlsx

(PS: j'ai testé avec tes PJ et cela fonctionne sur mon PC)

VB:
Sub Archivage()
Dim dWKS As Worksheet, SRC_Rng As Range, Dest_Rng As Range

Application.ScreenUpdating = False
Select Case InStr(ThisWorkbook.Name, "BU")
    Case Is > 0
    Set dWKS = Workbooks("BUDATA_VIR.xlsx").Sheets("BU_PI")
    Case Else
    Set dWKS = Workbooks("BUDATA_VIR.xlsx").Sheets("B_PV")
End Select
Set Dest_Rng = dWKS.Cells(Rows.Count, 1).End(xlUp)(2)
'Copie du contenu de data
With Sheets("Data")
    Set SRC_Rng = .Cells(2, 1).Resize(.Cells(Rows.Count, "A").End(xlUp).Row - 1, 7)
    SRC_Rng.Copy: Dest_Rng.PasteSpecial -4163
    Application.CutCopyMode = False: .[A2].Select
End With
'inscrire la date de la copie
Dest_Rng.Offset(, 7) = Date
'enregistrement et fermeture du fichier d'archivage
Workbooks("BUDATA_VIR.xlsx").Close True
Application.ScreenUpdating = True
End Sub
 

Nyepalo

XLDnaute Junior
[RESOLU] Copier-coller vers en fonction de la source

Bonjour à tous,

Staple1600, merci pour l'intérêt et votre réaction avec une amélioration, je vous en remercie. Cependant, le code ne traite pas le point 7. Si le nom du fichier source est PI alors,
J'ai ajouté "Windows("PV.xlsm").Activate" pour que l'exécution se déroule sans erreurs, les données sont bien collées dans la bonne feuille.
Pour contourner le risque d'oublier d'ouvrir le classeur de sauvegarde, j'ai ajouté l'ouverture automatique du classeur

Code:
Sub Archivage()
Dim dWKS As Worksheet, SRC_Rng As Range, Dest_Rng As Range
Dim fic As String

Application.ScreenUpdating = False
'Ouverture du fichier d'archivage
fic = "C:\BUDATA_VIR.xlsx"
Workbooks.Open (fic)
Select Case InStr(ThisWorkbook.Name, "BU")
    Case Is > 0
    Set dWKS = Workbooks("BUDATA_VIR.xlsx").Sheets("BU_PI")
    Case Else
    Set dWKS = Workbooks("BUDATA_VIR.xlsx").Sheets("B_PV")
End Select
Set Dest_Rng = dWKS.Cells(Rows.Count, 1).End(xlUp)(2)
'Activation classeur source
Windows("PV.xlsm").Activate 'jai ajouté cette ligne pour que l'exécution se déroule sans échec.
'Copie du contenu de data
With Sheets("Data")
    Set SRC_Rng = .Cells(2, 1).Resize(.Cells(Rows.Count, "A").End(xlUp).Row - 1, 7)
    SRC_Rng.Copy: Dest_Rng.PasteSpecial -4163
    Application.CutCopyMode = False: .[A2].Select
End With
'inscrire la date de la copie
Dest_Rng.Offset(, 7) = Date
'enregistrement et fermeture du fichier d'archivage
Workbooks("BUDATA_VIR.xlsx").Close True
Application.ScreenUpdating = True
End Sub

Merci encore pour votre contribution.

Cordialement,
 
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…