lepigoennier
XLDnaute Junior
Bonjour à tous,
Jai créé une macro dans Excel 2010. Elle fonctionne très bien sur mon ordinateur au bureau, mais lorsque je l'essaye sur l'ordinateur de quelqu'un d'autre au travail, elle ne fonctionne pas à la perfection. Est-ce que quelqu'un pourrait éclairer ma lanterne?
Merci
Voici la macro en question
'Arranger la colonne de part number
'
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Range("C1").Select
ActiveCell.FormulaR1C1 = "Part Number"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(SEARCH(""SUB"",RC[1])),RC[1],RC[2])"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C10500")
Range("C2:C10500").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("D:E").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
'Ajouter colonne Total matérial pour oter les totaux de la colonne sub component
Columns("G:G").Select
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Range("H1").Select
ActiveCell.FormulaR1C1 = "Total Material"
Range("H2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]=""total"","""",RC[1])"
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H10500")
Range("H2:H10500").Select
Columns("D").Select
Selection.Insert Shift:=xlToRight
Range("D1").Select
ActiveCell.FormulaR1C1 = "Component"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[1]="""",RC[2],RC[1])"
'Oter les espacs inutiles et du copier/coller
Range("D2").Select
Selection.AutoFill Destination:=Range("D210500")
Range("D210500").Select
Columns("E:E").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("E:F").Select
Application.CutCopyMode = False
Columns("I:I").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("J:J").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("E:F").Select
Range("F1").Activate
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
'Standardiser le nom des catégories
Columns("A:A").Select
Selection.Replace What:="INTERIOR WALLS", Replacement _
:="INTERIOR W", LookAt:=xlPart, SearchOrder:=xlByRows _
, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="INTERIOR W", Replacement:= _
"INTERIOR WALLS", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="BATT,ALTER", Replacement _
:="BATT, C", LookAt:=xlPart, SearchOrder:=xlByRows _
, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="BATT", Replacement:= _
"BATT,ALTER", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="DISTRIBUTOR", Replacement _
:="DISTRI", LookAt:=xlPart, SearchOrder:=xlByRows _
, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="DISTRI", Replacement:= _
"DISTRIBUTOR", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="MASK DECALS", Replacement:= _
"MASK", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="MASK", Replacement:= _
"MASK DECALS", LookAt:=xlPart, SearchOrder:=xlByRows _
, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="PUBLIC ADD", _
Replacement:="PUBLIC", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="PUBLIC", Replacement:= _
"PUBLIC ADD", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="ARTICULATED", Replacement:= _
"ARTICULA", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="ARTICULA", Replacement:= _
"ARTICULATED", LookAt:=xlPart, SearchOrder:=xlByRows _
, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'Aller chercher le % estimé des fournisseurs
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Range("G1").Select
Workbooks.Open Filename:= _
"D:\Suppliers BAA % estimate.xlsx"
Windows("Bus régulier.xlsm").Activate
ActiveCell.FormulaR1C1 = "% BAA estimated"
Range("G2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-2],'[Suppliers BAA % estimate.xlsx]ABClist20130701USA'!C3:C5,3,FALSE)"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G10500")
Range("G2:G10500").Select
Columns("E:E").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("G:G").Select
Selection.Style = "Percent"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="#n/a", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Les colonnes pour les certificats et liens
Columns("D:F").Select
Selection.Insert Shift:=xlToRight
Range("D1").Select
ActiveCell.FormulaR1C1 = "lien"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Certificat"
Range("F1").Select
ActiveCell.FormulaR1C1 = "% US on certificate"
Range("D2").Select
ActiveCell.FormulaR1C1 = ""
Range("D2").Select
Workbooks.Open Filename:= _
"D:\données BAA.xls"
Windows("Bus régulier.xlsm").Activate
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[données BAA.xls]Certificats'!C1:C6,6,FALSE)"
Range("D3").Select
ActiveWindow.SmallScroll Down:=-3
Range("D2").Select
Selection.AutoFill Destination:=Range("D210500")
Range("D210500").Select
Columns("C:C").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E2").Select
ActiveWindow.SmallScroll Down:=-12
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Columns("D").Select
Selection.Replace What:="#n/a", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("E2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""."","""",HYPERLINK(RC[-1],RC[-2]))"
Range("E2").Select
Selection.Copy
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
Range("E3:E10500").Select
ActiveSheet.Paste
Range("F2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-3],'[données BAA.xls]Certificats'!C1:C5,5,FALSE)"
Range("F2").Select
Selection.AutoFill Destination:=Range("F2:F10500")
Range("F2:F10500").Select
Selection.Style = "Percent"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="#n/a", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Mise en forme conditionnelle des colonnes
Columns("F:F").ColumnWidth = 18.14
Columns("F:F").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("C1").Select
Application.CutCopyMode = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=F1=100%"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274 'vert
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=F1=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255 'rouge
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ET(F1>0;F1<100%)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535 'jaune
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ET(F1=""."";J1<>""."")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 15773696 'bleu
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.Copy
Columns("C:C").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Columns("D").Select
Selection.EntireColumn.Hidden = True
Range("A1").Select
MsgBox ("SVP enregistrez une copie dans vos dossiers")
Application.Dialogs(xlDialogSaveAs).Show
MsgBox ("Otez les lignes à 0 et les vides dans Total Matérial et exécutez la macro Publipostage")
End Sub
Jai créé une macro dans Excel 2010. Elle fonctionne très bien sur mon ordinateur au bureau, mais lorsque je l'essaye sur l'ordinateur de quelqu'un d'autre au travail, elle ne fonctionne pas à la perfection. Est-ce que quelqu'un pourrait éclairer ma lanterne?
Merci
Voici la macro en question
'Arranger la colonne de part number
'
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Range("C1").Select
ActiveCell.FormulaR1C1 = "Part Number"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(SEARCH(""SUB"",RC[1])),RC[1],RC[2])"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C10500")
Range("C2:C10500").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("D:E").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
'Ajouter colonne Total matérial pour oter les totaux de la colonne sub component
Columns("G:G").Select
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Range("H1").Select
ActiveCell.FormulaR1C1 = "Total Material"
Range("H2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]=""total"","""",RC[1])"
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H10500")
Range("H2:H10500").Select
Columns("D").Select
Selection.Insert Shift:=xlToRight
Range("D1").Select
ActiveCell.FormulaR1C1 = "Component"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[1]="""",RC[2],RC[1])"
'Oter les espacs inutiles et du copier/coller
Range("D2").Select
Selection.AutoFill Destination:=Range("D210500")
Range("D210500").Select
Columns("E:E").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("E:F").Select
Application.CutCopyMode = False
Columns("I:I").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("J:J").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("E:F").Select
Range("F1").Activate
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
'Standardiser le nom des catégories
Columns("A:A").Select
Selection.Replace What:="INTERIOR WALLS", Replacement _
:="INTERIOR W", LookAt:=xlPart, SearchOrder:=xlByRows _
, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="INTERIOR W", Replacement:= _
"INTERIOR WALLS", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="BATT,ALTER", Replacement _
:="BATT, C", LookAt:=xlPart, SearchOrder:=xlByRows _
, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="BATT", Replacement:= _
"BATT,ALTER", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="DISTRIBUTOR", Replacement _
:="DISTRI", LookAt:=xlPart, SearchOrder:=xlByRows _
, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="DISTRI", Replacement:= _
"DISTRIBUTOR", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="MASK DECALS", Replacement:= _
"MASK", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="MASK", Replacement:= _
"MASK DECALS", LookAt:=xlPart, SearchOrder:=xlByRows _
, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="PUBLIC ADD", _
Replacement:="PUBLIC", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="PUBLIC", Replacement:= _
"PUBLIC ADD", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="ARTICULATED", Replacement:= _
"ARTICULA", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="ARTICULA", Replacement:= _
"ARTICULATED", LookAt:=xlPart, SearchOrder:=xlByRows _
, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'Aller chercher le % estimé des fournisseurs
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Range("G1").Select
Workbooks.Open Filename:= _
"D:\Suppliers BAA % estimate.xlsx"
Windows("Bus régulier.xlsm").Activate
ActiveCell.FormulaR1C1 = "% BAA estimated"
Range("G2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-2],'[Suppliers BAA % estimate.xlsx]ABClist20130701USA'!C3:C5,3,FALSE)"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G10500")
Range("G2:G10500").Select
Columns("E:E").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("G:G").Select
Selection.Style = "Percent"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="#n/a", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Les colonnes pour les certificats et liens
Columns("D:F").Select
Selection.Insert Shift:=xlToRight
Range("D1").Select
ActiveCell.FormulaR1C1 = "lien"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Certificat"
Range("F1").Select
ActiveCell.FormulaR1C1 = "% US on certificate"
Range("D2").Select
ActiveCell.FormulaR1C1 = ""
Range("D2").Select
Workbooks.Open Filename:= _
"D:\données BAA.xls"
Windows("Bus régulier.xlsm").Activate
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[données BAA.xls]Certificats'!C1:C6,6,FALSE)"
Range("D3").Select
ActiveWindow.SmallScroll Down:=-3
Range("D2").Select
Selection.AutoFill Destination:=Range("D210500")
Range("D210500").Select
Columns("C:C").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E2").Select
ActiveWindow.SmallScroll Down:=-12
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Columns("D").Select
Selection.Replace What:="#n/a", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("E2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""."","""",HYPERLINK(RC[-1],RC[-2]))"
Range("E2").Select
Selection.Copy
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
Range("E3:E10500").Select
ActiveSheet.Paste
Range("F2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-3],'[données BAA.xls]Certificats'!C1:C5,5,FALSE)"
Range("F2").Select
Selection.AutoFill Destination:=Range("F2:F10500")
Range("F2:F10500").Select
Selection.Style = "Percent"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="#n/a", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Mise en forme conditionnelle des colonnes
Columns("F:F").ColumnWidth = 18.14
Columns("F:F").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("C1").Select
Application.CutCopyMode = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=F1=100%"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274 'vert
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=F1=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255 'rouge
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ET(F1>0;F1<100%)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535 'jaune
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ET(F1=""."";J1<>""."")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 15773696 'bleu
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.Copy
Columns("C:C").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Columns("D").Select
Selection.EntireColumn.Hidden = True
Range("A1").Select
MsgBox ("SVP enregistrez une copie dans vos dossiers")
Application.Dialogs(xlDialogSaveAs).Show
MsgBox ("Otez les lignes à 0 et les vides dans Total Matérial et exécutez la macro Publipostage")
End Sub
Dernière édition: