fleurdasie
XLDnaute Nouveau
Bonsoir à tous!
Je voudrais savoir si quelqu'un parmis vous serez prêt à m'aider à relire ma macro que j'ai créée et me dire s'il est possible de raccourcir certaine partie...
Je l'a trouve d'une trop longue et de deux, plus je la manipule, et plus j'ai des messages d'erreurs! alors qu'elle marchait parfaitement bien hier!
Voici le code :
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Msg, Style, Title, Response As String
Msg = "You are about to refresh the call log. Do you want to continue?"
' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Warning" ' Define title.
' context.
' Display message.
Response = MsgBox(Msg, Style, Title)
If Response = vbNo Then Exit Sub
Application.DisplayAlerts = False
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I8").Select
ActiveCell.FormulaR1C1 = "Current Outstanding Amount"
With ActiveCell.Characters(Start:=1, Length:=28).Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("H8").Select
ActiveCell.FormulaR1C1 = "Previous Outstanding Amount"
With ActiveCell.Characters(Start:=1, Length:=27).Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Sheets("Data").Select
Sheets("Data").Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Sheets("Data").Columns("C:J").Select
Selection.Delete Shift:=xlToLeft
Sheets("Call Log").Select
Range("I9").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(C[-4],'Data'!C[-8]:C[-6],3,0),""PAID"")"
Range("I9:I" & Range("H65536").End(xlUp).Row).FillDown
Columns("I:I").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("G:G").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Dim i As Integer, derniereligne As Integer
derniereligne = Range("H65536").End(xlUp).Row
For i = derniereligne To 1 Step -1
If Cells(i, 8).Value = "PAID" Then
Rows(i).Delete
End If
Next
Sheets("Data").Select
Sheets("Data").Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Data").Range("E2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(C[-4],'Call Log'!C,1,0),""New"")"
Range("E2:E" & Range("D65536").End(xlUp).Row).FillDown
Sheets("Data").Columns("E:E").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
AutoFilterMode = False
Range("A1:E1").AutoFilter
Range("A1:E1").AutoFilter Field:=5, Criteria1:="New"
ActiveSheet.Range("a1", ActiveSheet.Range("D65536").End(xlUp)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Call Log").Select
Sheets("Call Log").[E65536].End(xlUp)(2).PasteSpecial xlValues
Dim i2 As Integer, derniereligne2 As Integer
derniereligne2 = Range("E65536").End(xlUp).Row
For i2 = derniereligne2 To 1 Step -1
If Cells(i2, 5).Value = "ClientName" Or Cells(i2, 5).Value = "Total Invoices value" Then
Rows(i2).Delete
End If
Next
AutoFilterMode = False
ActiveWorkbook.Worksheets("Call Log").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Call Log").AutoFilter.Sort.SortFields.Add Key:= _
Range("H8:H65536"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Call Log").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
ActiveWorkbook.Worksheets("Call Log").AutoFilter.Sort.SortFields.Clear
End With
MsgBox "Finished'"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
A mon dernier tri par ordre décroissant, j'ai l'erreur 91 qui apparaît
Merci beaucoup pour votre aide!!!
Je voudrais savoir si quelqu'un parmis vous serez prêt à m'aider à relire ma macro que j'ai créée et me dire s'il est possible de raccourcir certaine partie...
Je l'a trouve d'une trop longue et de deux, plus je la manipule, et plus j'ai des messages d'erreurs! alors qu'elle marchait parfaitement bien hier!
Voici le code :
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Msg, Style, Title, Response As String
Msg = "You are about to refresh the call log. Do you want to continue?"
' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Warning" ' Define title.
' context.
' Display message.
Response = MsgBox(Msg, Style, Title)
If Response = vbNo Then Exit Sub
Application.DisplayAlerts = False
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I8").Select
ActiveCell.FormulaR1C1 = "Current Outstanding Amount"
With ActiveCell.Characters(Start:=1, Length:=28).Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("H8").Select
ActiveCell.FormulaR1C1 = "Previous Outstanding Amount"
With ActiveCell.Characters(Start:=1, Length:=27).Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Sheets("Data").Select
Sheets("Data").Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Sheets("Data").Columns("C:J").Select
Selection.Delete Shift:=xlToLeft
Sheets("Call Log").Select
Range("I9").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(C[-4],'Data'!C[-8]:C[-6],3,0),""PAID"")"
Range("I9:I" & Range("H65536").End(xlUp).Row).FillDown
Columns("I:I").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("G:G").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Dim i As Integer, derniereligne As Integer
derniereligne = Range("H65536").End(xlUp).Row
For i = derniereligne To 1 Step -1
If Cells(i, 8).Value = "PAID" Then
Rows(i).Delete
End If
Next
Sheets("Data").Select
Sheets("Data").Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Data").Range("E2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(C[-4],'Call Log'!C,1,0),""New"")"
Range("E2:E" & Range("D65536").End(xlUp).Row).FillDown
Sheets("Data").Columns("E:E").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
AutoFilterMode = False
Range("A1:E1").AutoFilter
Range("A1:E1").AutoFilter Field:=5, Criteria1:="New"
ActiveSheet.Range("a1", ActiveSheet.Range("D65536").End(xlUp)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Call Log").Select
Sheets("Call Log").[E65536].End(xlUp)(2).PasteSpecial xlValues
Dim i2 As Integer, derniereligne2 As Integer
derniereligne2 = Range("E65536").End(xlUp).Row
For i2 = derniereligne2 To 1 Step -1
If Cells(i2, 5).Value = "ClientName" Or Cells(i2, 5).Value = "Total Invoices value" Then
Rows(i2).Delete
End If
Next
AutoFilterMode = False
ActiveWorkbook.Worksheets("Call Log").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Call Log").AutoFilter.Sort.SortFields.Add Key:= _
Range("H8:H65536"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Call Log").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
ActiveWorkbook.Worksheets("Call Log").AutoFilter.Sort.SortFields.Clear
End With
MsgBox "Finished'"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
A mon dernier tri par ordre décroissant, j'ai l'erreur 91 qui apparaît
Merci beaucoup pour votre aide!!!