Code ne veux plus fonctionne

Fermé
acmilan2028 Messages postés 9 Date d'inscription mercredi 19 mars 2014 Statut Membre Dernière intervention 23 juillet 2014 - Modifié par acmilan2028 le 31/05/2014 à 10:38
Le Pingou Messages postés 12041 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 22 avril 2024 - 31 mai 2014 à 22:40
bonjour j'ai travailler avec ce code sans aucun problème jusqu'à ces jours là il ne fonctionne pas et il n'arrive pas a copie les colonnes sélectionner veuillez m'aidez S.V.P
voila le code la partie en gras c'est ça où le probleme arrive comme je crois



Worksheets("liens").Activate
echeancier = Range("A1").Value
With Workbooks.Open(echeancier)
Application.ScreenUpdating = False
Sheets("Macros").Visible = True
Worksheets("Macros").Activate
date_début_1er_bout = Range("B13").Value
date_fin_1er_bout = Range("C13").Value
Key = Range("B25")
Worksheets("Echéancier").Activate

'--------------------------------filtrer suivant la GAP---------------------------

GAP = ComboBox1.Value

If ComboBox1.Value = "S11" Or ComboBox1.Value = "S13" Or ComboBox1.Value = "S15-A" Or ComboBox1.Value = "S15-B" Or ComboBox1.Value = "S16" Then
i = Range("A2").End(xlDown).Row
Range("F2").Select
Selection.AutoFilter
ActiveSheet.Range("$A$2:$FL$" & i).AutoFilter Field:=6, Criteria1:="" & GAP
End If


dateDébut = CDate(TextBox1.Value)
DateFin = CDate(TextBox2.Value)

i = Range("A2").End(xlDown).Row

With Worksheets("Echéancier")
If .FilterMode = False Then
.Range("BS2").AutoFilter
End If
End With

'--------------------extraire les MSN et VBs de la periode à partir de l'echeancier-------------------------


Dim Cellule As Range, Rng As Range
Dim Debut As Long, fin As Long, dat As Long, Début_cycle As Long, Fin_cycle As Long


dateDébut = CDate(TextBox1.Value)
DateFin = CDate(TextBox2.Value)
i = Range("A2").End(xlDown).Row

For j = 3 To i
If IsDate(Cells(j, date_début_1er_bout)) = True Then
Début_cycle = CDate(Cells(j, date_début_1er_bout))
Fin_cycle = CDate(Cells(j, date_fin_1er_bout))
If Début_cycle >= "" & dateDébut And Début_cycle <= "" & DateFin And Fin_cycle >= "" & dateDébut And Fin_cycle <= "" & DateFin _
Or Fin_cycle >= "" & dateDébut And Début_cycle <= "" & dateDébut _
Or Fin_cycle >= "" & DateFin And Début_cycle <= "" & DateFin Then
If Rng Is Nothing Then
Set Rng = Union(Cells(j, Key), Range(Cells(j, date_début_1er_bout - 2), Cells(j, date_fin_1er_bout + 1)))
Else
Set Rng = Union(Rng, Union(Cells(j, Key), Range(Cells(j, date_début_1er_bout - 2), Cells(j, date_fin_1er_bout + 1))))
End If

End If
End If
Next j

Rng.Select
Application.ScreenUpdating = True
Selection.Copy

Application.Workbooks("Besoin Outillage").Activate
Worksheets("Planifier").Activate
Range("A6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
.Close SaveChanges:=False


End With
A voir également:

1 réponse

Le Pingou Messages postés 12041 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 22 avril 2024 1 426
31 mai 2014 à 22:40
Bonjour,
Quel changement est intervenu entre avant et maintenant ?
Qu'elle est le code d'erreur du système ?

0