Bonjour tout le monde,
D'avance je m'excuse s'il existe déjà un sujet qui ressemble au miens mais moi j'ai cherché et pas trouvé mon bonheur
J'ai un bogue dans un code qui a toujours fonctionné (la macro est utilisée mensuellement depuis des années).
Quand j'exécute ma macro, elle s'arrête après quelques secondes. Je clique sur "débogage" et la ligné surlignée est celle du début de la boucle "do until"
Voici le code en entier (la ligne qui bogue est la 4ème après "Dim..."
Avez-vous une idée d'où Est-ce que ça pourrait venir svp ?
Sub decoupage(destination)
'
' decoupage Macro
'
Dim lig As Long
Dim zonage As Range
lig = 1
Do Until Cells(lig, 1) = "FINAL "
If Cells(lig, 1) = "ENTETE" Then
Cells(lig + 1, 1).Select
Selection.EntireRow.Insert
'chargement des donnees entete en bb1
entete lig
End If
If Cells(lig, 1) = "FINENT" Then
Cells(lig, 1).Select
Selection.EntireRow.Insert
lig = lig + 1
'chargement des donnees finent en bb10
pied lig
' copie des lignes détails
Range(Cells(lig - 2, 3).Address).CurrentRegion.Copy
entitesheet.Select
Range("B8").PasteSpecial Paste:=xlValues
' recherche de la fin de la feuille
Set zonage = Range(Selection.Address)
' mise en forme du format des cellules et bordure de la fin
Range("B8:AY8").Copy
zonage.PasteSpecial Paste:=xlFormats
' bordure de fin
zonage.Rows(zonage.Rows.Count).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
' définition de la zone d'impression
ActiveSheet.PageSetup.PrintArea = Selection.CurrentRegion.Address
'
'
' ajustement de la largeur des colonnes & positionement en A1
Columns("A:AY").AutoFit
Range("A1").Select
' ajustement de la largeur de la colonne B
Columns("B:B").Select
Selection.ColumnWidth = 6
' ajustement de la largeur de la colonne A
Columns("A:A").Select
Selection.ColumnWidth = 1
'
' ydu masque la colonne P si somme colonne P = 0
MasqueColonneP
'
' protection de la feuille
' mise en commentaire le 04/07/2013
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' THH
Nomf = ActiveSheet.Name
ActiveSheet.Move
' ActiveWorkbook.SaveAs (destination & "PR_" & Nomf & "_" & Left(Range("$BB$3"), 4) & Left(Range("$BB$22"), 5) & Right(Range("$BB$4"), 2) & ".xls")
DefaultFilePath = "C:\AERETOUR\"
ActiveWorkbook.SaveAs (destination & "PR__STD_" & Nomf & "_" & Left(Range("$BB$3"), 5) & Right(Range("$BB$4"), 2) & ".xlsx")
DefaultFilePath = "C:\AERETOUR\"
ActiveWorkbook.Close
' Workbooks(Workbooks.Count).Close
' THH
provsheet.Select
End If
lig = lig + 1
Loop
End Sub
D'avance je m'excuse s'il existe déjà un sujet qui ressemble au miens mais moi j'ai cherché et pas trouvé mon bonheur
J'ai un bogue dans un code qui a toujours fonctionné (la macro est utilisée mensuellement depuis des années).
Quand j'exécute ma macro, elle s'arrête après quelques secondes. Je clique sur "débogage" et la ligné surlignée est celle du début de la boucle "do until"
Voici le code en entier (la ligne qui bogue est la 4ème après "Dim..."
Avez-vous une idée d'où Est-ce que ça pourrait venir svp ?
Sub decoupage(destination)
'
' decoupage Macro
'
Dim lig As Long
Dim zonage As Range
lig = 1
Do Until Cells(lig, 1) = "FINAL "
If Cells(lig, 1) = "ENTETE" Then
Cells(lig + 1, 1).Select
Selection.EntireRow.Insert
'chargement des donnees entete en bb1
entete lig
End If
If Cells(lig, 1) = "FINENT" Then
Cells(lig, 1).Select
Selection.EntireRow.Insert
lig = lig + 1
'chargement des donnees finent en bb10
pied lig
' copie des lignes détails
Range(Cells(lig - 2, 3).Address).CurrentRegion.Copy
entitesheet.Select
Range("B8").PasteSpecial Paste:=xlValues
' recherche de la fin de la feuille
Set zonage = Range(Selection.Address)
' mise en forme du format des cellules et bordure de la fin
Range("B8:AY8").Copy
zonage.PasteSpecial Paste:=xlFormats
' bordure de fin
zonage.Rows(zonage.Rows.Count).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
' définition de la zone d'impression
ActiveSheet.PageSetup.PrintArea = Selection.CurrentRegion.Address
'
'
' ajustement de la largeur des colonnes & positionement en A1
Columns("A:AY").AutoFit
Range("A1").Select
' ajustement de la largeur de la colonne B
Columns("B:B").Select
Selection.ColumnWidth = 6
' ajustement de la largeur de la colonne A
Columns("A:A").Select
Selection.ColumnWidth = 1
'
' ydu masque la colonne P si somme colonne P = 0
MasqueColonneP
'
' protection de la feuille
' mise en commentaire le 04/07/2013
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' THH
Nomf = ActiveSheet.Name
ActiveSheet.Move
' ActiveWorkbook.SaveAs (destination & "PR_" & Nomf & "_" & Left(Range("$BB$3"), 4) & Left(Range("$BB$22"), 5) & Right(Range("$BB$4"), 2) & ".xls")
DefaultFilePath = "C:\AERETOUR\"
ActiveWorkbook.SaveAs (destination & "PR__STD_" & Nomf & "_" & Left(Range("$BB$3"), 5) & Right(Range("$BB$4"), 2) & ".xlsx")
DefaultFilePath = "C:\AERETOUR\"
ActiveWorkbook.Close
' Workbooks(Workbooks.Count).Close
' THH
provsheet.Select
End If
lig = lig + 1
Loop
End Sub