Erreur d'execution "13" incompatibilité de type
Bonjour,
Vu le petit bout de code .... pas sur de la réponse ; donc sauf si vous avez déclaré "Cel" comme variable
l'écriture c'est plutôt :
For Each Cell
En debut de macro il y'a Dim cel as range
Personnellement je déclarerai plutôt la plage en variable.
Dim Cell as range
Dim Maselection as range
Set Maselection =Range("H4:H" & Range("H66999").End(xlUp).Row)
For Each Cell in Maselection
if Cell.value="Stable" then
....
Bonjour,
En debut de macro il y'a Dim cel as range
Vous avez bien un WITH avant la première ligne ?
Montrez le code complet ou tout au moins le code avant les lignes que vous avez postées
Crdlt
Voici le code complet
Sub SAVE_RDV_ATTENDUS()
Dim dossier$
Dim Chemin As String, P, p1, cel As Range, x As Variant, dl As Long
Dim F, w As Worksheet, fichier$, periode$
Application.ScreenUpdating = False
Chemin = ThisWorkbook.Path & "\RDV_PREVUS\"
If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin
fichier = Month(Sheets("TB").Range("B11")) & "-" & "Liste des RDV" & " " & Sheets("TB").Range("B8") & "" & Format(Sheets("TB").Range("B11"), " mmmm yyyy")
periode = Format(Sheets("TB").Range("B11"), " mmmm yyyy") & " " & Sheets("TB").Range("B8")
Application.ScreenUpdating = False
Set F = ActiveWorkbook.Worksheets("RDV")
With F
.Visible = True
.Unprotect "2580"
End With
Application.ScreenUpdating = False
Application.EnableEvents = False
Workbooks.Add (xlWBATWorksheet)
Application.EnableEvents = True
With ActiveWorkbook
Application.ScreenUpdating = False
F.Range("A3:J" & F.Range("A" & Rows.Count).End(xlUp).Row + 1).Copy Destination:=.Worksheets(1).Cells(3, 2)
Application.CutCopyMode = False
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = False
With .Sheets(1)
Application.ScreenUpdating = False
dl = .Range("B" & Rows.Count).End(xlUp).Row
.Range("B3").Copy
.Range("A3:K3").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
.Range("B4:K" & dl).Sort key1:=.Range("J4"), order1:=xlDescending
.Range("A3").FormulaR1C1 = "N°"
.Range("A4").Value = dl - 3
If dl > 4 Then
.Range("A5:A" & dl).FormulaR1C1 = "=R[-1]C-1"
.Range("A4:A" & dl).Value = .Range("A4:A" & dl).Value
.Range("A4:K" & dl).Sort key1:=.Range("A4"), order1:=xlAscending
End If
.PageSetup.Zoom = False
.Cells(1).Select
.Columns("A:K").AutoFit
.Range("$A$1:$K$" & dl).Font.Name = "Arial Narrow"
.Range("$A$1:$K$" & dl).Font.Size = 12
.Range("$A$4:$K$" & dl).Font.Bold = False
.[A1] = "RENDEZ_VOUS ATTENDUS DU MOIS DE " & " " & periode
.Range("$A$1:$K$1").MergeCells = True
.Range("$A$1:$K$1").Font.Bold = True
.Range("$A$1:$K$1").HorizontalAlignment = xlCenter
.Range("$A$1:$K$1").VerticalAlignment = xlCenter
.Range("A3").Copy
.Range("$A$4:$A$" & dl).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
.PageSetup.Zoom = False
.PageSetup.PrintArea = .Range("$A$1:$K$" & dl).Address
.PageSetup.Orientation = xlPortrait
.PageSetup.FitToPagesTall = 1
.PageSetup.FitToPagesWide = False
.PageSetup.RightFooter = "&P de &N"
.PageSetup.LeftMargin = Application.InchesToPoints(0.118110236220472)
.PageSetup.RightMargin = Application.InchesToPoints(0.118110236220472)
.Range("A3:K" & .Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = xlContinuous
.Range("A3:A" & .Range("A" & Rows.Count).End(xlUp).Row).HorizontalAlignment = xlCenter
.Range("A3:A" & .Range("A" & Rows.Count).End(xlUp).Row).VerticalAlignment = xlCenter
.Range("C3:K" & .Range("A" & Rows.Count).End(xlUp).Row).HorizontalAlignment = xlCenter
.Range("C3:K" & .Range("A" & Rows.Count).End(xlUp).Row).VerticalAlignment = xlCenter
.Range("C4:C" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "dd-mmm-yy"
.Range("J4:J" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "dd-mmm-yy"
.Range("E4:E" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "0"
.Range("I4:I" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "0"
.Range("K4:K" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "0"
.Cells(1).Select
For Each cel In .Range("H4:H" & .Range("H" & Rows.Count).End(xlUp).Row)
If cel.Value = "Stable" Then .Range("A" & cel.Row & ":K" & cel.Row).Font.Bold = True
Next cel
End With
Application.ScreenUpdating = False
Application.DisplayAlerts = False
.SaveAs Chemin & fichier, 51
.Close
End With
F.Visible = False
Set F = Nothing
End Sub
Bonjour KTM,
Tu peux essayer comme ça
Sub SAVE_RDV_ATTENDUS()
Dim dossier$
Dim Chemin As String, P, p1, Cel As Range, x As Variant, dl As Long
Dim Wbk As Workbook, F As Worksheet, F1 As Worksheet, fichier$, periode$
Application.ScreenUpdating = False
Chemin = ThisWorkbook.Path & "\RDV_PREVUS\"
If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin
fichier = Month(Sheets("TB").Range("B11")) & "-" & "Liste des RDV" & " " & Sheets("TB").Range("B8") & "" & Format(Sheets("TB").Range("B11"), " mmmm yyyy")
periode = Format(Sheets("TB").Range("B11"), " mmmm yyyy") & " " & Sheets("TB").Range("B8")
Application.ScreenUpdating = False
Set F = ActiveWorkbook.Worksheets("RDV")
With F
.Visible = True
.Unprotect "2580"
End With
Application.ScreenUpdating = False
Application.EnableEvents = False
Set Wbk = Workbooks.Add(xlWBATWorksheet)
Application.EnableEvents = True
' Définir la feuille du nouveau classeur
Set F1 = Wbk.Sheets(1)
Application.ScreenUpdating = False
F.Range("A3:J" & F.Range("A" & Rows.Count).End(xlUp).Row + 1).Copy Destination:=F1.Cells(3, 2)
Application.CutCopyMode = False
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = False
dl = F1.Range("B" & Rows.Count).End(xlUp).Row
F1.Range("B3").Copy
F1.Range("A3:K3").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
F1.Range("B4:K" & dl).Sort key1:=F1.Range("J4"), order1:=xlDescending
F1.Range("A3").FormulaR1C1 = "N°"
F1.Range("A4").Value = dl - 3
If dl > 4 Then
F1.Range("A5:A" & dl).FormulaR1C1 = "=R[-1]C-1"
F1.Range("A4:A" & dl).Value = F1.Range("A4:A" & dl).Value
F1.Range("A4:K" & dl).Sort key1:=F1.Range("A4"), order1:=xlAscending
End If
F1.PageSetup.Zoom = False
F1.Columns("A:K").AutoFit
With F1.Range("$A$1:$K$" & dl)
With .Font
.Name = "Arial Narrow"
.Size = 12
.Bold = False
End With
End With
F1.[A1] = "RENDEZ_VOUS ATTENDUS DU MOIS DE " & " " & periode
With F1.Range("$A$1:$K$1")
.MergeCells = True
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
F1.Range("A3").Copy
F1.Range("$A$4:$A$" & dl).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With F1.PageSetup
.Zoom = False
.PrintArea = F1.Range("$A$1:$K$" & dl).Address
.Orientation = xlPortrait
.FitToPagesTall = 1
.FitToPagesWide = False
.RightFooter = "&P de &N"
.LeftMargin = Application.InchesToPoints(0.118110236220472)
.RightMargin = Application.InchesToPoints(0.118110236220472)
End With
F1.Range("A3:K" & F1.Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = xlContinuous
F1.Range("A3:A" & F1.Range("A" & Rows.Count).End(xlUp).Row).HorizontalAlignment = xlCenter
F1.Range("A3:A" & F1.Range("A" & Rows.Count).End(xlUp).Row).VerticalAlignment = xlCenter
F1.Range("C3:K" & F1.Range("A" & Rows.Count).End(xlUp).Row).HorizontalAlignment = xlCenter
F1.Range("C3:K" & F1.Range("A" & Rows.Count).End(xlUp).Row).VerticalAlignment = xlCenter
F1.Range("C4:C" & F1.Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "dd-mmm-yy"
F1.Range("J4:J" & F1.Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "dd-mmm-yy"
F1.Range("E4:E" & F1.Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "0"
F1.Range("I4:I" & F1.Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "0"
F1.Range("K4:K" & F1.Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "0"
For Each Cel In F1.Range("H4:H" & F1.Range("H" & Rows.Count).End(xlUp).Row)
If Cel.Value = "Stable" Then F1.Range("A" & Cel.Row & ":K" & Cel.Row).Font.Bold = True
Next Cel
Wbk.SaveAs Chemin & fichier, 51
Wbk.Close
F.Visible = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set Wbk = Nothing: Set F = Nothing: Set F1 = Nothing
End Sub
@+
Vous êtes sur la feuille 1 lorsque l'erreur se produit. Voir donc dans cette feuille si c'est la bonne feuille
Juste un truc votre variable F doit être déclarée --> Dim F as worksheet.
Là vous avez Dim F, F est donc Variant et pas worksheet
Sinon j'aurais plutot essayé de découper le code en plusieurs macros car là pour lire ....
Cordialement
edit : oups Bruno, désolé je viens de voir que tu avais répondu...