Erreur code VBA copie lignes

[rudymagny]

Bonsoir à tous,
J'avais fais un fil sur le thème copier lignes de différents feuilles dans une seule, j'ai essayer un truc qui m'a l'air possible mais ça ne fonctionne pas:

Private Sub CommandButton26_Click(ByVal Target As Range)
Dim mois As Variant
Dim date0 As String
Dim li As Integer
Dim dest As Range
Target As Range

'If TextBox7 = '' Then
'Call MsgBox('Veuillez donner la date de la réunion CDR!', vbCritical, 'VCT-Essais E4-->Erreur de Saisie')
'TextBox7.SetFocus
'Exit Sub
'End If

date0 = TextBox7.Value

For Each mois In Array('Janvier', 'Février', 'Mars', 'Avril', 'Mai', 'Juin', 'Juillet', 'Aout', 'Septembre', 'Octobre', 'Novembre', 'Décembre')
Sheets(mois).Activate

Rows('4:4').Select
Selection.AutoFilter
Selection.AutoFilter Field:=28, Criteria1:='30/03/06'

If Not Application.Intersect(Target, Range('AC4:AC20000')) Is Nothing Then

'Si la cellule contient une case à cocher:
If Target.Value Like '[30/03/06]' Then
li = Target.Row 'définit la variable li qui correspond à la ligne
'/////définit la variable dest
With Sheets('FeuilE5')
If .Range('B5').Value = '' Then
Set dest = .Range('B5')
Else
Set dest = .Range('B65536').End(xlUp).Offset(1, 0)
End If
End With
'copie la ligne de la case cochée de l'onglet en cours et la colle dans l'onglet 'Signature E5' de l'autre feuille
Range(Cells(li, 2), Cells(li, 29)).Copy Destination:=dest
End If
Exit Sub
End If

Next mois
End Sub

Il bloc sur le -->
Private Sub CommandButton26_Click(ByVal Target As Range)

???

Merci d'avance

 

[rudymagny]

Private Sub CommandButton26_Click(ByVal Target As Range)
Dim mois As Variant
Dim date0 As String
Dim li As Integer
Dim dest As Range
Target As Range

'If TextBox7 = '' Then
'Call MsgBox('Veuillez donner la date de la réunion CDR!', vbCritical, 'VCT-Essais E4-->Erreur de Saisie')
'TextBox7.SetFocus
'Exit Sub
'End If

date0 = TextBox7.Value

For Each mois In Array('Janvier', 'Février', 'Mars', 'Avril', 'Mai', 'Juin', 'Juillet', 'Aout', 'Septembre', 'Octobre', 'Novembre', 'Décembre')
Sheets(mois).Activate

Rows('4:4').Select
Selection.AutoFilter
Selection.AutoFilter Field:=28, Criteria1:='30/03/06'

If Not Application.Intersect(Target, Range('AC4:AC20000')) Is Nothing Then

If Target.Value Like '[30/03/06]' Then
li = Target.Row 'définit la variable li qui correspond à la ligne
'/////définit la variable dest
With Sheets('FeuilE5')
If .Range('B5').Value = '' Then
Set dest = .Range('B5')
Else
Set dest = .Range('B65536').End(xlUp).Offset(1, 0)
End If
End With
'copie la ligne résultante du filtre et la colle dans FeuilE5
Range(Cells(li, 2), Cells(li, 29)).Copy Destination:=dest
End If
Exit Sub
End If

Next mois
End Sub

 

[rudymagny]

Private Sub CommandButton26_Click(ByVal Target As Range)
Dim mois As Variant
Dim date0 As String
Dim li As Integer
Dim dest As Range
Target As Range

'If TextBox7 = '' Then
'Call MsgBox('Veuillez donner la date de la réunion CDR!', vbCritical, 'VCT-Essais E4-->Erreur de Saisie')
'TextBox7.SetFocus
'Exit Sub
'End If

date0 = TextBox7.Value

For Each mois In Array('Janvier', 'Février', 'Mars', 'Avril', 'Mai', 'Juin', 'Juillet', 'Aout', 'Septembre', 'Octobre', 'Novembre', 'Décembre')
Sheets(mois).Activate

Rows('4:4').Select
Selection.AutoFilter
Selection.AutoFilter Field:=28, Criteria1:='30/03/06'

If Not Application.Intersect(Target, Range('AC4:AC20000')) Is Nothing Then

If Target.Value Like '[30/03/06]' Then
li = Target.Row 'définit la variable li qui correspond à la ligne
'/////définit la variable dest
With Sheets('FeuilE5')
If .Range('B5').Value = '' Then
Set dest = .Range('B5')
Else
Set dest = .Range('B65536').End(xlUp).Offset(1, 0)
End If
End With
'copie la ligne résultante du filtre et la colle dans FeuilE5
Range(Cells(li, 2), Cells(li, 29)).Copy Destination:=dest
End If
Exit Sub
End If

Next mois
End Sub

 

[rudymagny]

Excusez moi j'arrive pas à faire apparaitre le code proprement! :unsure: