Fonction Copy Destination ne marche qu'une fois
Bonjour à tous,
Je viens vous demander votre humble aide afin de m'aider à résoudre un problème sur lequel je bloque depuis des jours maintenant.
En fait, en fonction de ce qui est marqué dans la colonne 4 (GESTION1, GESTION2 ...) du fichier Destination, je veux extraire l'ensemble des lignes et les mettre dans le fichier correspondant (GESTION1,GESTION2..) que j'aurais préalablement crée et qui est vide.
Le problème est simple: il me fait ce que je veux pour GESTION1 mais il ne me fait plus rien pour les autres et je n'ai pas d'erreur. Je me demandais alors si la fonction Copy Destination ne marchait qu'une fois ?
Public Sub Equipe()
Workbooks("Copie de BSCI.xls").Activate
Dim wsDestination As Worksheet
Dim wsgestion1 As Worksheet
Dim wsgestion2 As Worksheet
Dim wsagent1 As Worksheet
Dim wsagent2 As Worksheet
Dim pcsr As Worksheet
Dim nbLigneDestination As Variant
Dim i As Variant
Dim j As Variant
With ThisWorkbook
Set wsgestion1 = Workbooks(.gestion1).Worksheets("Feuil1")
Set wsgestion2 = Workbooks(.gestion2).Worksheets("Feuil1")
Set wsagent1 = Workbooks(.agent1).Worksheets("Feuil1")
Set wsagent2 = Workbooks(.agent2).Worksheets("Feuil1")
Set wspcsr = Workbooks(.pcsr).Worksheets("Feuil1")
Set wsDestination = Workbooks(.destination).Worksheets("Feuil1")
nbLigneDestination = wsDestination.Cells(Rows.Count, 1).End(xlUp).Row
'Copie des lignes dans chaque fichier excel de GESTION1
Workbooks(.destination).Worksheets("Feuil1").Activate
Workbooks(.gestion1).Worksheets("Feuil1").Activate
wsDestination.Rows(1).Copy
wsgestion1.Rows(1).EntireRow.PasteSpecial
wsDestination.Rows(1).Copy
wsgestion2.Rows(1).EntireRow.PasteSpecial
wsDestination.Rows(1).Copy
wsagent1.Rows(1).EntireRow.PasteSpecial
wsDestination.Rows(1).Copy
wsagent2.Rows(1).EntireRow.PasteSpecial
wsDestination.Rows(1).Copy
wspcsr.Rows(1).EntireRow.PasteSpecial
For i = 2 To nbLigneDestination
If wsDestination.Cells(i, 4) = "GESTION1" Then
wsDestination.Range("a" & i & ":x" & i).Copy _
destination:=wsgestion1.Range("a" & i & ":x" & i)
ElseIf wsDestination.Cells(i, 4) = "GESTION2" Then
wsDestination.Range("a" & i & ":x" & i).Copy _
destination:=wsgestion2.Range("a" & i & ":x" & i)
ElseIf wsDestination.Cells(i, 4) = "AGENT1" Then
wsDestination.Range("a" & i & ":x" & i).Copy _
destination:=wsagent1.Range("a" & i & ":x" & i)
ElseIf wsDestination.Cells(i, 4) = "AGENT2" Then
wsDestination.Range("a" & i & ":x" & i).Copy _
destination:=wsagent2.Range("a" & i & ":x" & i)
ElseIf wsDestination.Cells(i, 4) = "PCSR" Then
wsDestination.Range("a" & i & ":x" & i).Copy _
destination:=wspcsr.Range("a" & i & ":x" & i)
End If
Next i
End with
End sub
Je remercie par avance tous ceux qui pourront m'aiclairer.
Bonne journée.
Vraiment personne n'a une petite idée?
wsDestination.Rows(1).Copy
wsgestion1.Rows(1).EntireRow.PasteSpecialMerci d'avance.
Bonsoir
Le plus simple tu fais une archive de tes fichiers, et tu la postes ici
Tu indiques (par des couleurs) les lignes qui doivent copiées dans tel ou tel fichier
J'ai du mal à interpréter une instruction de ce style
Set wsgestion1 = Workbooks(.gestion1).Worksheets("Feuil1")