Utiliser un compteursous macro VBA
Bonjour, je viens chercher votre aide par rapport à un problème de code que je n’ai pas pu résoudre il y a deux semaines et plus. Je suis débutante et j’apprends à travers les recherches mais ce n’est pas toujours évident de réussir malgré cela. Alors il se peut que je fais du n’importe quoi.
Je vous mets en jointure les deux fichiers et voilà mon code.
L’idée est de pouvoir copier toutes les dates d’achat du « fichier source » et de les coller suivant un ordre chronologique date 1, date 2, date 3 ….date n dans le fichier de destination.
Je reste bloquée dans la partie ou toutes les dates d’achat ne peuvent pas être sélectionnées (Selon le code, seule la dernière date saisie sera stockée or il serait plus intéressant de pouvoir les stockée tous en une seule fois).
Mon deuxième souci est la partie If et else if: Mon idée étant de renseigner au fur à mesure les colonnes une à une suivant les dates d’achat en considérant que les dates ne seront pas les mêmes.
Mon code me convient pour deux dates mais s'il s'agit de renseigner au fur et à mesure 10 dates dans 10 colonnes différentes, ce code ne serait plus adapté, or c'est ce que je cherche à faire surtout.
Alors si quelqu'un pourrait me venir en aide, n'y aurait-il pas une boucle plus adapté pour renseigner successivement ces colonnes. Le meilleur des cas est de réussir à copier toutes les dates de récolte et de les coller sur chaque colonne du fichier B suivant l'ordre chronologique. Mais tant que je peux résoudre le problème de boucle, ça m’aiderait largement.
voici le code
Sub test()
Dim ach
Dim ddate
Dim colrec As Integer
With Workbooks("Fichier A").Worksheets("Ca")
ddate = 1
For i = 1 To 10
If Cells(i, "E") = "Achat" Then
ach = Cells(i, ddate).Value
End If
Next i
ddate = ddate + 1
End With
On Error Resume Next
Workbooks("Fichier B").Activate
If Err <> 0 Then
Workbooks.Open ("F:\stage\Fichier B.xlsm")
End If
Worksheets("Feuil1").Select
colrec = 5
For i = 1 To 10
If Cells(i, "D") = "Ca" Then
Cells(i, colrec).Select
If Cells(i, colrec) = 0 Then
Cells(i, colrec) = ach
ElseIf Cells(i, colrec) <> 0 Then
colrec = colrec + 1
Cells(i, colrec) = ach
End If
End If
Next i
End Sub