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

Nyepalo · 4 Septembre 2015

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 :

Classeur source, feuille « Data »
Ouvre le classeur archivage
Revenir au classeur source, feuille « Data »
Sélectionne la plage des cellules puis copie des données,
Va dans le classeur archivage,
Choix de la feuille appropriée
Si le nom du fichier source est PI alors,
Va dans archivage
Sélectionne la feuille BU_PI
Place le curseur à la première ligne vide de la zone de copie
Ecrit la date du jour dans la colonne date copie
Copie les données en valeur
Sinon
Sélectionne la feuille BU_PV
Place le curseur à la première ligne vide de la zone de copie
Ecrit la date du jour dans la colonne date copie
Copie les données en valeur
Fin
Enregistre et Ferme Archivage.xlsx
Revenir au classeur source

Merci d'avance de votre précieuse aide.

Staple1600 · 6 Septembre 2015

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 · 7 Septembre 2015

[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,

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

Nyepalo

XLDnaute Junior

Pièces jointes

Staple1600

XLDnaute Barbatruc

Nyepalo

XLDnaute Junior

Discussions similaires