Instruction d'une boucle ne s'exécutant pas à chaque passage
Bonjour á tous,
Je suis confronté à un petit problème que je n'arrive pas à résoudre par moi-même.
Concrètement, mon problème est simple.
J'ai un document avec une base de donnée excel pour enregistrer les achats en fonction des marques et fournisseurs. Cette base de données sert á remplir un tableau de cashflows oú les marques fournisseurs sont classés par ordre alphabetique.
Ma macro verifie pour les nouvelles lignes de la base de donnée si le fournisseur est deja present dans la base des cashflows. Si ce n est pas le cas, elle insere une nouvelle ligne, copie les formules, puis retrie pour retrouver un ordre alphabetique correct.
Il y a une boucle for qui passe en revue toutes les nouvelles lignes de la BDD. Mon probleme est que lorsque j execute la marco, il y a certains passages où l'instruction d'insertion de ligne n effectue pas. Alors que quand j effectue pas à pas la marco, toutes les instructions fonctionnent bien. Il n'y a pas de message d'erreur, rien, juste elle ne s'effectue pas, comme muette. A noter que la fonction sleep est la pour tenter de "simuler" une lecture pas à pas
Je vous remercie de votre aide!
Voici mon document, et le code pour ceux qui ne veulent pas le telecharger.
Rob
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub UpdateList()
Application.ScreenUpdating = False
Dim first As Long
Dim last1 As Long
Dim last2 As Long
Dim c1 As Long
Dim c2 As Long
Dim cc As Worksheet
Dim cd As Worksheet
Dim proveedor As String
Set cc = ThisWorkbook.Worksheets("Registro de Facturas")
Set cd = ThisWorkbook.Worksheets("CashFlows - Invierno")
'determination of first
first = cc.Range("O1").End(xlDown).Row
'determination of last1
If cc.Range("A2").Value = Empty Then
last1 = 2
Else: last1 = 3
End If
If cc.Range("A2").Value <> Empty And cc.Range("A3").Value <> Empty Then
last1 = cc.Range("A2").End(xlDown).Row
End If
'determination of last2
If cd.Range("A5").Value = Empty Then
last2 = 5
Else: last2 = 6
End If
If cd.Range("A5").Value <> Empty And cc.Range("A6").Value <> Empty Then
last2 = cd.Range("A5").End(xlDown).Row
End If
'check whether the brand - supplier is already in the list
For i = first To last1
For j = 5 To last2
If cc.Range("V" & i).Value = cd.Range("D" & j).Value Then
GoTo suite
End If
Next j
Sleep 3000
last2 = last2 + 1
Rows(last2).Insert
cd.Range("A" & last2).Value = cc.Range("F" & i).Value
cd.Range("B" & last2).Value = cc.Range("D" & i).Value
cd.Range("C" & last2).Value = cc.Range("E" & i).Value
cd.Range("D" & last2).Value = cc.Range("V" & i).Value
'copier formules
cd.Activate
c1 = 5
c2 = cd.Range("E5").End(xlToRight).Column
cd.Activate
cd.Range(Cells((last2 - 1), c1), Cells((last2 - 1), c2)).Select
Selection.AutoFill Destination:=Range(Cells((last2 - 1), c1), Cells(last2, c2)), Type:=xlFillDefault
ActiveWorkbook.Worksheets("CashFlows - Invierno").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("CashFlows - Invierno").AutoFilter.Sort.SortFields.Add Key:= _
Range("A4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("CashFlows - Invierno").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=-12
suite:
Next i
'Erase the "NO"
cc.Activate
cc.Range(Cells(first, 15), Cells(last1, 15)).Select
Application.CutCopyMode = False
Selection.ClearContents
End Sub
Bonjour
robbydrop a écrit :Voici mon document
Pas vu, pas pris
Ahh pour ceux que ça interesserait; J'ai compris mon problème : un simple probleme de .Activate lors de la premiere boucle!
Bonne soirée á tous!