VBA copier coller vers plusieurs feuilles excel Résolu/Fermé

Question

Bonjour à tous, 

Je suis débutant en VBA et j'ai un problème avec une macro que je tente de créer. 
En fait je souhaite archiver des données d'une feuille ("A") qui contient le gestion de divers équipement
vers plusieurs autres feuilles ("C") et ("D") en fonction de la référence.
Ainsi au départ seule la feuille A est rempli et elle contient des références pour chacun des équipements à gérer. Je souhaiterais copier chacun de ces équipements soit dans la feuille "C" si la référence de l'équipement commence par CCC soit dans la feuille "D" si la référence de l'équipement commence par DDD.

A savoir que la feuille a sera régulier vidé puis reremplit manuellement mais cela ne doit pas venir écraser les données archiver feuille "C" et "D".


J'ai utilisé ce code pour archiver sans écraser les données de la feuille "A" vers la feuille "B"

Sub TEST()
    Sheets("A").Activate
    Range("A9").CurrentRegion.Select
    Selection.Copy
    Sheets("B").Activate
    Range("A65536").End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
End Sub

Maintenant je n'arrive pas à copier les données dans des feuilles différentes selon leur référence

Quelqu'un pourrait-il me conseiller ? merci d'avance de votre aide

michel_m · Answer

Bonjour

pour essayer d'^tre efficace:


mettre le classeur sans données confidentielles en pièce jointe sur
https://www.cjoint.com/ 
puis copier l'adresse du lien et la coller dans le message de réponse

dédé65000 · Answer

Voici le lien 

https://www.cjoint.com/?3CkqEYWs7PP

foo · Answer

Bonjour

Voila ta macro modifier

Sub TestA()
Nlig = Range("A" & Rows.Count).End(xlUp).Row
Lig1 = Sheets("C").Range("A" & Rows.Count).End(xlUp).Row
Lig2 = Sheets("D").Range("A" & Rows.Count).End(xlUp).Row
For L = 8 To Nlig
   Sh = Range("A" & L).Value
   If Sh <> "" Then
      Select Case Sh
         Case "C"
            Lig1 = Lig1 + 1
            Lig = Lig1
         Case "D"
            Lig2 = Lig2 + 1
            Lig = Lig2
      End Select
      Rows(L).Copy
      Sheets(Sh).Range("A" & Lig).PasteSpecial xlPasteValues
   End If
Next
Application.CutCopyMode = False
End Sub

A+
Maurice

dédé65000 · Answer

Génial c'est exactement ce que je voulais merci beaucoup 

Bonne continuation

foo · Answer

Bonjour

Comme ca ses mieux

Sub Test()
Application.ScreenUpdating = False
Nlig = Range("A" & Rows.Count).End(xlUp).Row
Lig1 = Sheets("C").Range("A" & Rows.Count).End(xlUp).Row
Lig2 = Sheets("D").Range("A" & Rows.Count).End(xlUp).Row
For L = Nlig To 8 Step -1
   Sh = Range("A" & L).Value
   If Sh <> "" Then
      Select Case Sh
         Case "C"
            Lig1 = Lig1 + 1
            Lig = Lig1
         Case "D"
            Lig2 = Lig2 + 1
            Lig = Lig2
      End Select
      Rows(L).Copy
      Sheets(Sh).Range("A" & Lig).PasteSpecial xlPasteValues
      Rows(L).Delete
   End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

A+
Maurice

VBA copier coller vers plusieurs feuilles excel

5 réponses

Discussions similaires