superbog
XLDnaute Occasionnel
Bonjour,
j'ai une macro qui ne fonctionne pas et visiblement c'est un problème de compilation puisque j'ai l'erreur end if sans bloc if, ou end with sans bloc with ou next sans for ...
pourtant if,with et for sont là
SOS, ci dessous le code
merci d'avance
j'ai une macro qui ne fonctionne pas et visiblement c'est un problème de compilation puisque j'ai l'erreur end if sans bloc if, ou end with sans bloc with ou next sans for ...
pourtant if,with et for sont là
SOS, ci dessous le code
Code:
Sub BB()
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("BB").Range("B9000").End(xlUp).Row
Set colFeuille = New Collection
On Error Resume Next
'Boucle sur la plage de cellule
For Each rCelA In Sheets("BB").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("B9000").End(xlUp).Row
'Copie les valeurs tp si non cochées
With Sheets("BB").Cells(i, "C").Resize(, 15)
If IsEmpty(Sheets("BB").Cells(i, 1)) And IsNumeric(Sheets("BB").Cells(i, 2)) Then
'colonne A vide
Err = 0 'pour savoir si une erreur se produit
Worksheets(dossier).Cells(lig + 1, "B").Resize(, 6) = .Value
Worksheets(dossier).Cells(lig + 1, "V").Resize(, 2) = .Value
Worksheets(dossier).Cells(lig + 1, "H") = "BB"
'Copie les valeurs devis
With Sheets("BB").Cells(i, "I").Resize(, 3)
Worksheets(dossier).Cells(lig + 1, "X").Resize(, 3) = .Value
End With
'copie la date conv hono
With Sheets("BB").Cells(i, "M").Resize(, 1)
Worksheets(dossier).Cells("G3").Resize(, 1) = .Value
If Err = 0 Then .Cells(-1) = "X"
End If
End With
Next i
End Submerci d'avance