Pourquoi ma macro ne marche pas quand je l'éxécute en une macro !

jihane

XLDnaute Junior
Bonjour à tous :)

J'ai un code qui marche bien quand je l'éxécute en deux temps(sous forme de 2 macro, voir pièce jointe) par contre quand je l'éxécute sous forme d'une seule macro, il bloque à la ligne en rouge ci dessous. Mon code en 2 macros est en pièce jointe, merci de me dire où se trouve mon erreur :rolleyes:

Le code:

Sub macro1()

Application.ScreenUpdating = False 'Pour accélérer la macro


'////// PARTIE 1 : SUPPRIMER LE SUPERFLU (mise en forme de base) //////


'Supprimer les feuilles superflues
Sheets(Array("anomalie VI pb BE", "anomalie SAP", "indicateur", "paramètre")). _
Select
Sheets("anomalie VI pb BE").Activate
ActiveWindow.SelectedSheets.Delete

'Supprimer tous ce qui n'est pas 'CIT' et 'DUP'
Selection.AutoFilter
ActiveSheet.Range("D:D").AutoFilter Field:=4, Criteria1:="="
ActiveSheet.Range("E:E").AutoFilter Field:=5, Criteria1:="="
Sheets("art sans doublon").Rows("2:65536").Delete
ActiveSheet.ShowAllData

'Création d'une nouvelle feuille "Montages sans doublon"
Sheets.Add after:=Sheets(Sheets.Count)
Sheets("feuil1").Name = "Montages sans doublon"
Sheets("art sans doublon").Select
Range("R1").AutoFilter Field:=18, Criteria1:="ZMON" 'Sélection de tous les 'ZMON'
Sheets("art sans doublon").Range("A:BU").Copy Destination:=Sheets("Montages sans doublon").Range("A1") 'Copier la sélection des 'ZMON' dans la nouvelle feuille crée

'Supprimer de la feuille tous les 'ZMON' sélectionné dans "art sans doublon"
Sheets("art sans doublon").Rows("2:65536").Delete
ActiveSheet.ShowAllData

'Insérer 8 nouvelles colonnes à partir de la colonne 'N'
Columns("N:U").Insert Shift:=xlToRight

'Récupérer la 1ère ligne du fichier "art acif base itc.xlsx"
With ThisWorkbook
Workbooks("art actif base itc.xlsx").Sheets("art sans doublon").Rows(1).Copy

.Sheets("art sans doublon").Rows(1).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.Sheets("art sans doublon").Paste



'////// PARTIE 2 : RECUPERER LES DONNEES DE LA SEMAINE PRECEDENTE (art.actif) //////'


'Récupérer les formules des colonnes O,P,Q,R,S,T,U,CE,CH,CF et CG
Range("O2:O" & Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC12,'[art actif base itc.xlsx]art sans doublon'!C12:C21,COLUMN(R1C)-11,FALSE)"
Selection.FillDown

Range("P2:p" & Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC12,'[art actif base itc.xlsx]art sans doublon'!C12:C21,COLUMN(R1C)-11,FALSE)"
Selection.FillDown

Range("Q2:Q" & Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC12,'[art actif base itc.xlsx]art sans doublon'!C12:C21,COLUMN(R1C)-11,FALSE)"
Selection.FillDown

Range("R2:R" & Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC12,'[art actif base itc.xlsx]art sans doublon'!C12:C21,COLUMN(R1C)-11,FALSE)"
Selection.FillDown

Range("S2:S" & Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC12,'[art actif base itc.xlsx]art sans doublon'!C12:C21,COLUMN(R1C)-11,FALSE)"
Selection.FillDown

Range("T2:T" & Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC12,'[art actif base itc.xlsx]art sans doublon'!C12:C21,COLUMN(R1C)-11,FALSE)"
Selection.FillDown

Range("U2:U" & Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC12,'[art actif base itc.xlsx]art sans doublon'!C12:C21,COLUMN(R1C)-11,FALSE)"
Selection.FillDown

Range("CE2:CE" & Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-71],'[art actif base itc.xlsx]art sans doublon'!C12:C83,71,FALSE)"
Selection.FillDown

Range("CH2:CH" & Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-74],'[art actif base itc.xlsx]art sans doublon'!C12:C86,75,FALSE)"
Selection.FillDown

Range("CF2:CF" & Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "=IF(OR(RC[-17]=""X"",RC[-45]=""A""),""Oui"",""Non"")"
Selection.FillDown

Range("CG2:CG" & Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "=IF(AND(RC[-81]=1,RC[-80]=1),""CIT et DUP"",IF(RC[-81]=1,""CIT"",IF(RC[-80]=1,""DUP"",0)))"
Selection.FillDown

'Formules maintenant récupérées !

'Ecraser les formules et ne garder que les valeurs dans les colonnes O,P,Q,R,S,T et U
Columns("O:U").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Ecraser les formules et ne garder que les valeurs dans les colonnes CE,CF,CG et CH
Columns("CE:CH").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False



' ////// PARTIE 3: RECUPERER LES DONNEES DE COUVERTURE //////


'Récupérer la formule de la colonne CD
Range("CD2:CD" & Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-70],[COMPILATION_COUVERTURE.xls]BASE!C7:C71,19,FALSE)"
Selection.FillDown

'Ecraser les formules de la colonne CD
Columns("CD:CD").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Supprimer les fournisseurs (1plus, 1stock et vides) dans la colonne AN de "COMPILATION_COUVERTURE.xls"
Windows("COMPILATION_COUVERTURE.xls").Activate
Range("AN2").AutoFilter
Range("AN2").AutoFilter Field:=40, Criteria1:=Array( _
"1-plus de 1BNC et pas bes. EBI => article couvert", "1-stock sur bes EBI", "=") _
, Operator:=xlFilterValues
Sheets("BASE").Rows("3:65536").Delete
ActiveSheet.ShowAllData


End With

Application.ScreenUpdating = True 'Pour accélérer la macro


End Sub





Sub macro2()

Application.ScreenUpdating = False 'Pour accélérer la macro


'Récupérer la formule de la colonne N
Range("N2:N" & Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],[COMPILATION_COUVERTURE.xls]BASE!C7:C60,34,FALSE)"
Selection.FillDown

'Sélectionner les #N/A dans les colonnes CH,N,O,P,Q,R,S,T et U et les modifier par les numéro de la semaine en cours
Dim i, ligne_fin As Integer
Dim sem As String

Application.Calculation = xlCalculationManual

sem = "S" & (Format(Date, "yy\0\0") + DatePart("ww", Date, 2, 2))

ligne_fin = Sheets("art sans doublon").Cells(65536, 12).End(xlUp).Row
For i = 2 To ligne_fin

If IsError(Cells(i, 86)) Then Cells(i, 86) = sem

If IsError(Cells(i, 15)) Then Cells(i, 15) = "?" & " " & sem
If IsError(Cells(i, 16)) Then Cells(i, 16) = "?" & " " & sem
If IsError(Cells(i, 17)) Then Cells(i, 17) = "?" & " " & sem
If IsError(Cells(i, 18)) Then Cells(i, 18) = "?" & " " & sem
If IsError(Cells(i, 19)) Then Cells(i, 19) = "?" & " " & sem
If IsError(Cells(i, 20)) Then Cells(i, 20) = "?" & " " & sem
If IsError(Cells(i, 21)) Then Cells(i, 21) = "?" & " " & sem

If IsError(Cells(i, 14)) Then Cells(i, 14) = "?"

Next

Application.Calculation = xlCalculationAutomatic

'Ecraser les formules de la colonne N
Columns("N:N").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False



' ////// PARTIE 4: MISE EN FORME FINALE //////


'Mettre les colonnes D,E,AE,AM et BO en orange et centré
'Mettre les colonnes D et E en orange et centré
Range("D1:E" & Range("A65536").End(xlUp).Row).Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Mettre la colonne AE en orange et centré
Range("AE1:AE" & Range("A65536").End(xlUp).Row).Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Mettre la colonne AM en orange et centré
Range("AM1:AM" & Range("A65536").End(xlUp).Row).Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Mettre la colonne BO en orange et centré
Range("BO1:BO" & Range("A65536").End(xlUp).Row).Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

'Mettre les colonnes N,CD et CE en orange
'Mettre la colonne N en orange
Range("N1:N" & Range("A65536").End(xlUp).Row).Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'Mettre les colonnes CD et CE en orange
Range("CD1:CE" & Range("A65536").End(xlUp).Row).Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With

'Mettre les colonnes O,P,Q,R,S,T et U en jaune
Range("O1:U" & Range("A65536").End(xlUp).Row).Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With

'Centrer les colonnes P,R et T
'Centrer la colonne P
Range("P1:p" & Range("A65536").End(xlUp).Row).Select
With Selection
.HorizontalAlignment = xlGeneral
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Centrer la colonne R
Range("R1:R" & Range("A65536").End(xlUp).Row).Select
With Selection
.HorizontalAlignment = xlGeneral
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Centrer la colonne T
Range("T1:T" & Range("A65536").End(xlUp).Row).Select
With Selection
.HorizontalAlignment = xlGeneral
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

'Mettre une bordure au tableau
ActiveSheet.UsedRange.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

'Copier la liste de choix
With ThisWorkbook
Workbooks("art actif base itc.xlsx").Sheets("Listes de choix").Copy Before:=.Sheets(1)

'Mettre la validation de données des colonnes O,Q,R,S,T et U
'Mettre la validation de données de la colonne O
Sheets("art sans doublon").Select
Range("O1:O" & Range("A65536").End(xlUp).Row).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='Listes de choix'!$A$2:$A$6"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

'Mettre la validation de données de la colonne Q
Range("Q1:Q" & Range("A65536").End(xlUp).Row).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='Listes de choix'!$A$9:$A$16"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With

'Mettre la validation de données de la colonne R
Range("R1:R" & Range("A65536").End(xlUp).Row).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='Listes de choix'!$A$19:$A$21"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

'Mettre la validation de données de la colonne S
Range("S1:S" & Range("A65536").End(xlUp).Row).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='Listes de choix'!$A$24:$A$35"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With

'Mettre la validation de données de la colonne T
Range("T1:T" & Range("A65536").End(xlUp).Row).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='Listes de choix'!$A$38:$A$40"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

'Mettre la validation de données de la colonne U
Range("U1:U" & Range("A65536").End(xlUp).Row).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='Listes de choix'!$A$43:$A$54"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With

'Macro permettant de nettoyer pour optimiser la taille du classeur après application de macros
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String
On Error Resume Next
Calc = Application.Calculation
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours..."
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = False
End With
For Each Sht In Worksheets
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Delete
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2)
If Not DCell Is Nothing Then _
Sht.Range(DCell, Sht.[IV1]).EntireColumn.Delete
End If
Rien = Sht.UsedRange.Address
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc


End With

Application.ScreenUpdating = True 'Pour accélérer la macro


End Sub
 

Pièces jointes

  • Sub macro1et2.docx
    17.5 KB · Affichages: 50
Dernière édition:

GeoTrouvePas

XLDnaute Impliqué
Re : Pourquoi ma macro ne marche pas quand je l'éxécute en une macro !

1) On ne connaît même pas le type d'erreur que tu obtiens
2) On ne sait même pas qu'elle est l'utilité de ton code
3) On ne connaît pas la structure de ton classeur et le type de données qu'il contient.

Pour résoudre ton problème, il faudrait au moins que l'on puisse tester ton code. Penses tu qu'il appartienne aux contributeurs de ce forum d'imaginer et de reconstituer ton classeur pour pouvoir te venir en aide ?

Si tu as vraiment besoin d'aide, fais au moins l'effort de créer un petit fichier épuré qui permettra à chacun de tester le fonctionnement de ton code.
 

Dranreb

XLDnaute Barbatruc
Re : Pourquoi ma macro ne marche pas quand je l'éxécute en une macro !

Bonjour.
Peut_être y a t-il plus de 32767 lignes renseignée ?

P.S Auquel cas, bien évidemment, ligne_fin doit être déclaré As Long et non As Integer qui provoquerait un dépassement de capacité.
À +
 
Dernière édition:

Discussions similaires

Réponses
11
Affichages
396

Statistiques des forums

Discussions
311 720
Messages
2 081 925
Membres
101 841
dernier inscrit
ferid87