sylvestre09
XLDnaute Nouveau
Bonjour le forum je souhaite grace à un bouton supprimer dans toutes les feuilles de mon classeur les lignes ou j'ai une date inferieur ou egale à la date d'aujourd'hui dans la colonne E sachant que j'ai le meme tableau dans toutes les feuilles (sauf feuil1 et feuil2) voilà mon code qui bloque
si quelqu'un pourrait m'aider ce serait gentil Merci d'avance !
Code:
Public Sub CB3_Click()
Dim L As Long, choix As Double, x As Long, y As Long, Dl As Long
Dim Sh As Worksheet, laDate As Long
Dim tboriginal, tbresult()
y = 0: laDate = Date
For Each Sh In Worksheets
If Sh.Name <> "Feuil1" And Sh.Name <> "Feuil2" Then
With Sh
Dl = .Range("E65536").End(xlUp).Row
tboriginal = .Range("A3:Q" & Dl) 'pour réinitialiser si erreur
choix = Application.WorksheetFunction.CountIf(.Range("E3:E" & Dl), ">" & laDate)
If choix > 0 Then
ReDim Preserve tbresult(1 To choix, 1 To 17)
For L = 3 To Dl
If .Range("E" & L) > Now Then
y = y + 1
For x = 1 To 17
tbresult(y, x) = .Cells(L, x) ' BLOQUE ICI
Next x
End If
Next L
.Range("A3:Q" & Dl).Delete (xlUp)
.Range("A3:Q" & choix + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("A3:Q" & choix + 1) = tbresult
End If
If MsgBox("Etes-vous sur du résultat", vbOKCancel) = 2 Then
.Range("A3:Q" & choix + 1).Delete (xlUp)
.Range("A3:Q" & Dl).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("A3:Q" & Dl) = tboriginal
End If
End With
End If
Next Sh
End Sub
si quelqu'un pourrait m'aider ce serait gentil Merci d'avance !