vba effet multiple complexe

[superbog]

bonjour à tous,

j'espère que les vacances ont été bonnes et la rentrée supportable 😉

petit souci, je n'arrive pas à me dépatouiller d'une macro

voilà, je voudrais qu'à partir d'une liste, la copie se fasse directement dans plusieurs fichiers différents avec en outre une inscription précise dans certaines cellules

merci d'avance de votre aide

 

[superbog]

Re : vba effet multiple complexe

bonjour à tous,

je me permets de relancer ce fil, si par gentillesse l'un d'entre vous avait au moins une piste pour m'aider car là je sèche réellement.

merci encore

 

[bof]

Re : vba effet multiple complexe

Bonjour,
Plus de 70 affichages et pas une réponse... ça me parait clair : Pour tout le monde tes explications sont incompréhensibles !
A+

 

[superbog]

Re : vba effet multiple complexe

merci, je viens donc de revoir ma copie

et du coup j'ai réussi

voici donc la macro

Sub test()

Dim i, DerLigBase, lig As Integer
Dim dossier, sNomFeuille As String
Dim colFeuille As Collection
Dim rCelA As Range
Dim shAct As Worksheet
Dim FeuilleExist As Boolean

'Recherche de la dernière ligne
DerLigBase = Sheets("forf").Range("B999").End(xlUp).Row
Set colFeuille = New Collection

On Error Resume Next
'Boucle sur la plage de cellule
For Each rCelA In Sheets("forf").Range("B2:B" & DerLigBase)
    colFeuille.Add rCelA, CStr(rCelA)
Next rCelA

'Recherche de la ligne et tri dans chaque feuille
For i = 2 To DerLigBase
    dossier = Cells(i, 2).Text
    lig = Sheets(dossier).Range("J999").End(xlUp).Row
     
     
     'Copie les valeurs si non cochées
With Sheets("forf").Cells(i, "C").Resize(, 4)
  If IsEmpty(.Cells(-1)) And IsNumeric(Sheets("forf").Cells(i, 2)) Then 'colonne A vide
    Err = 0 'pour savoir si une erreur se produit
    Worksheets(dossier).Cells(lig + 1, "J").Resize(, 4) = .Value
       Worksheets(dossier).Cells(lig + 1, "O").Resize(, 3) = .Value
Worksheets(dossier).Cells(lig + 1, "R") = "dp"
Worksheets(dossier).Cells(lig + 1, "T") = 13

    If Err = 0 Then .Cells(-1) = "X"
  End If
End With


Next i

End Sub