Bonjour Mimimathy !
Touché Coulé !
Tout est parfait !
Un grand MERCI !
Pour tester, j’ai dupliqué le dernier tableau “Cash” (pour ajouter la période du 5/02 au 12/02) et les lignes DATA sont bien recopiées ! c’est nickel ! je vais pouvoir faire une année complète.
Par pure mesure de professionnalisme, est il possible de copier les donnés sans mise en forme ?
Egalement, quand je clique une deuxième fois sur “afficher” les données sont copiées deux fois.
Pour comprendre la colonne “N° location” en onglet DATA doit être considéré comme un identifiant unique, qui ne peut jamais apparaître deux fois.
Il faudrait que :
-
si la ligne copiée en CASH est strictement identique à une ligne déjà présente dans le même onglet, alors elle ne soit pas copiée deux fois,
-
par contre, si une ligne déjà présente en CASH est modifiée, il faudrait qu’elle soit supprimée puis remplacé par une nouvelle (avec peut être une date de retour différente)
Et pour finir histoire de pas mourir bête, tu saurais m’expliquer ton code ?
Sub Test()
'********************************
'* DECLARATIONS DES VARIABLES *
'********************************
Dim Ws As Worksheet, Wd As Worksheet
Dim Pd As Date, Dd As Date
Dim Pdte%, Ddte%, Ligne%
Dim l%, i%, j%, Dls%, Dld%
'********************************
'* INITIALISATION DES VARIABLES *
'********************************
Application.ScreenUpdating = False
Set Ws = Sheets("DATA")
Set Wd = Sheets("CASH")
Dls = Ws.Range("A" & Rows.Count).End(xlUp).Row
Dld = Wd.Range("A" & Rows.Count).End(xlUp).Row + 1000
j = 1
For i = j To Dld
If Wd.Cells(i, 1) = "Cash début de période" Then
Pdte = i
For j = i To Dld
If Wd.Cells(j, 1) = "Cash fin de période" Then
Ddte = j
Pd = Wd.Cells(Pdte, 6).Value
Dd = Wd.Cells(Ddte, 6).Value
Ligne = Pdte + 3
Ws.Activate
For l = 2 To Dls
If Ws.Cells(l, 6).Value >= Dd Then
Dld = Wd.Range("A" & Rows.Count).End(xlUp).Row
Exit For
Else
If Ws.Cells(l, 6).Text >= Pd Then
Ws.Range(Cells(l, 1), Cells(l, 18)).Copy Wd.Cells(Ligne, 1)
Ligne = Ligne + 1
With Wd
.Rows(Ligne).EntireRow.Insert
.Rows(Ligne - 1).Copy .Rows(Ligne)
.Range(.Cells(Ligne, 1), .Cells(Ligne, 18)) = ""
End With
Dld = Wd.Range("A" & Rows.Count).End(xlUp).Row
End If
End If
Next l
i = Ddte
Exit For
End If
Next j
End If
Dld = Wd.Range("A" & Rows.Count).End(xlUp).Row
Next i
Wd.Activate
End Sub