Bonjour,
Je viens de faire une sub pour règler mon problème de TCD qui plante régulièrement...(sujet qui date un peu).
Mon code fonctionne et je parviens a obtenir le même résultat qu'avec mon TCD.
Seul souci, la procédure ne s'arrête pas...
En fait, lorsque la plage de données a été balayée de haut en bas... il recommence depuis la première ligne...
Comme mes compétences plafonnent (liées a mon petit niveau) j'ai besoin d'un coup de main.
Voici le code :
Sub TABPAIEMENT()
Dim DLIGNE As Range
Dim fin As String
Dim Recherche As Range
Dim ligne As String
Dim NB As String
Dim FACT As String
Dim Montant As String
Dim test As String
ligne = 2
test = 0
With Sheets("PRODUCTION").Range("A:A")
Set DLIGNE = .Find(what:="", LookAt:=xlWhole, LookIn:=xlValues)
If Not DLIGNE Is Nothing Then
Else
GoTo fin
End If
fin = DLIGNE.Row
End With
Sheets("TABPAIEMENT").Range("A1:B100").Clear
Sheets("PRODUCTION").Select
Selection:
With Sheets("PRODUCTION").Range("O:O")
If test = 0 Then
Set Recherche = .Find(what:="A payer", LookAt:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext)
If Not Recherche Is Nothing Then
Else
GoTo fin
End If
Else
Set Recherche = .FindNext(Recherche)
If Not Recherche Is Nothing Then
Else
GoTo fin
End If
End If
End With
With Sheets("PRODUCTION").Range("PROD")
If .Cells(Recherche.Row, 2) = "mon client" Then
FACT = .Cells(Recherche.Row, 5).Value
Montant = .Cells(Recherche.Row, 9).Value
test = test + 1
GoTo Tableau
Else
test = test + 1
GoTo Selection
End If
End With
Tableau:
With Sheets("TABPAIEMENT")
.Range("A1").Value = "Paiement Global"
.Cells(ligne, 1).Value = FACT
.Cells(ligne, 2).Value = Montant
ligne = ligne + 1
GoTo Selection
End With
fin:
end sub
Je viens de faire une sub pour règler mon problème de TCD qui plante régulièrement...(sujet qui date un peu).
Mon code fonctionne et je parviens a obtenir le même résultat qu'avec mon TCD.
Seul souci, la procédure ne s'arrête pas...
En fait, lorsque la plage de données a été balayée de haut en bas... il recommence depuis la première ligne...
Comme mes compétences plafonnent (liées a mon petit niveau) j'ai besoin d'un coup de main.
Voici le code :
Sub TABPAIEMENT()
Dim DLIGNE As Range
Dim fin As String
Dim Recherche As Range
Dim ligne As String
Dim NB As String
Dim FACT As String
Dim Montant As String
Dim test As String
ligne = 2
test = 0
With Sheets("PRODUCTION").Range("A:A")
Set DLIGNE = .Find(what:="", LookAt:=xlWhole, LookIn:=xlValues)
If Not DLIGNE Is Nothing Then
Else
GoTo fin
End If
fin = DLIGNE.Row
End With
Sheets("TABPAIEMENT").Range("A1:B100").Clear
Sheets("PRODUCTION").Select
Selection:
With Sheets("PRODUCTION").Range("O:O")
If test = 0 Then
Set Recherche = .Find(what:="A payer", LookAt:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext)
If Not Recherche Is Nothing Then
Else
GoTo fin
End If
Else
Set Recherche = .FindNext(Recherche)
If Not Recherche Is Nothing Then
Else
GoTo fin
End If
End If
End With
With Sheets("PRODUCTION").Range("PROD")
If .Cells(Recherche.Row, 2) = "mon client" Then
FACT = .Cells(Recherche.Row, 5).Value
Montant = .Cells(Recherche.Row, 9).Value
test = test + 1
GoTo Tableau
Else
test = test + 1
GoTo Selection
End If
End With
Tableau:
With Sheets("TABPAIEMENT")
.Range("A1").Value = "Paiement Global"
.Cells(ligne, 1).Value = FACT
.Cells(ligne, 2).Value = Montant
ligne = ligne + 1
GoTo Selection
End With
fin:
end sub