[Excel] Passer au next suivant si erreur

Résolu/Fermé
elglouton Messages postés 189 Date d'inscription dimanche 19 avril 2009 Statut Membre Dernière intervention 11 novembre 2022 - 11 janv. 2013 à 21:04
elglouton Messages postés 189 Date d'inscription dimanche 19 avril 2009 Statut Membre Dernière intervention 11 novembre 2022 - 12 janv. 2013 à 11:32
Bonjour,

Je tente de copier un commentaire de cellule
J'ai une problème j'ai créer un loop pour copier mes cellules mais quand j'ai une cellule sans commentaire cela cause une erreur comment faire pour l'ignorer et passer à la cellule suivante

https://www.cjoint.com/c/CAlvd3TUIsO

Dans l'attente de vous lire Merci

Option Explicit

Sub Macro4()
Dim Tent As String, Tent2 As String, tata As String, tata2 As String, derl As Long, derl3 As Long, derl2 As Long, i As Long, k As Long, RefKits As String, DenoKits As String, j As String, V As String, n As Long, TypeEnt As Long
derl = Sheets("Kits").Range("G65536").End(xlUp).Row

Sheets("test").Cells.Clear
Application.ScreenUpdating = False

If UImp.Periodes.Value = "A" Then TypeEnt = 6
If UImp.Periodes.Value = "S" Then TypeEnt = 5
If UImp.Periodes.Value = "Q" Then TypeEnt = 7

For i = 3 To derl
derl2 = Sheets("test").Range("Y65536").End(xlUp).Row
k = derl2 + 1
Sheets("Kits").Select

V = Cells(1, 5).Value
    tata = Cells(i, TypeEnt).Comment.Text
    tata2 = Application.Substitute(tata, Chr(10), " ; ")
    RefKits = Cells(i, 3)
    DenoKits = Cells(i, 1)
    

Sheets("test").Select

    'Cells(1, 1).FormulaR1C1 = "Liste de pieces pour entretien" & j & " Autoclave " & V
    Cells(k, 1).FormulaR1C1 = RefKits
    Cells(k, 2).FormulaR1C1 = tata2
    
    Cells(k, 2).Select
    Selection.TextToColumns Destination:=Cells(k, 3), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=";", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
        TrailingMinusNumbers:=True
    Range(Cells(k, 3), Cells(k, 23)).Select
    Selection.Copy
    Cells(k, 25).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

derl3 = Sheets("test").Range("Y65536").End(xlUp).Row
n = derl3 - 1
    Range(Cells(k, 2), Cells(n, 28)).Select
    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
Range(Cells(1, 1), Cells(n, 28)).Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    
    Next i


Columns("B:X").Select
    Selection.Delete Shift:=xlToLeft
Range("A1") = "Ref Kit"
Range("B1") = "Elément"
Range("C1") = "Changé             "
Range("D1") = "Etat               "
Range("E1") = "Commantaire        "
Columns("A:W").EntireColumn.AutoFit
Columns("A:W").VerticalAlignment = xlTop
Columns("B:B").Select
    Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Application.ScreenUpdating = True
Sheets("test").Select
    Application.ActivePrinter = "PDFCreator sur Ne00:"
    ExecuteExcel4Macro _
    "PRINT(1,,,1,,,,,,,,2,""PDFCreator sur Ne00:"",,TRUE,,FALSE)"
End Sub



A voir également:

1 réponse

gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 688
Modifié par gbinforme le 11/01/2013 à 21:13
Bonjour,

cela cause une erreur comment faire pour l'ignorer et passer à la cellule suivante

tu mets une instruction :
on error resume next


puis après l'instruction qui peut causer l'erreur, tu mets
if err.number = 0 then 

et dans ce cas tu exécutes ton code, et tu mets le "end if" avant le next de la cellule suivante.
Toujours zen
La perfection est atteinte, non pas lorsqu'il n'y a plus rien à ajouter, mais lorsqu'il n'y a plus rien à retirer. Antoine de Saint-Exupéry
1
elglouton Messages postés 189 Date d'inscription dimanche 19 avril 2009 Statut Membre Dernière intervention 11 novembre 2022 1
11 janv. 2013 à 21:44
Bonsoir gbinforme

J'ai pas trouver tout de suite ou placer les text exactement mais ta réponse étant parfaite
Un grand merci a vous pour cette réponse

Option Explicit

Sub Macro4()
Dim Tent As String, Tent2 As String, tata As String, tata2 As String, derl As Long, derl3 As Long, derl2 As Long, i As Long, k As Long, RefKits As String, DenoKits As String, j As String, V As String, n As Long, TypeEnt As Long
derl = Sheets("Kits").Range("G65536").End(xlUp).Row

Sheets("test").Cells.Clear
Application.ScreenUpdating = False

If UImp.Periodes.Value = "A" Then TypeEnt = 6
If UImp.Periodes.Value = "S" Then TypeEnt = 5
If UImp.Periodes.Value = "Q" Then TypeEnt = 7

For i = 3 To derl
On Error Resume Next
derl2 = Sheets("test").Range("Y65536").End(xlUp).Row
k = derl2 + 1
Sheets("Kits").Select

V = Cells(1, 5).Value
    tata = Cells(i, TypeEnt).Comment.Text
    If Err.Number = 0 Then
    tata2 = Application.Substitute(tata, Chr(10), " ; ")
    RefKits = Cells(i, 3)
    DenoKits = Cells(i, 1)
    

Sheets("test").Select

    'Cells(1, 1).FormulaR1C1 = "Liste de pieces pour entretien" & j & " Autoclave " & V
    Cells(k, 1).FormulaR1C1 = RefKits
    Cells(k, 2).FormulaR1C1 = tata2
    
    Cells(k, 2).Select
    Selection.TextToColumns Destination:=Cells(k, 3), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=";", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
        TrailingMinusNumbers:=True
    Range(Cells(k, 3), Cells(k, 23)).Select
    Selection.Copy
    Cells(k, 25).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

derl3 = Sheets("test").Range("Y65536").End(xlUp).Row
n = derl3 - 1
    Range(Cells(k, 2), Cells(n, 28)).Select
    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
Range(Cells(1, 1), Cells(n, 28)).Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    
    End If
    Next i


Columns("B:X").Select
    Selection.Delete Shift:=xlToLeft
Range("A1") = "Ref Kit"
Range("B1") = "Elément"
Range("C1") = "Changé             "
Range("D1") = "Etat               "
Range("E1") = "Commantaire        "
Columns("A:W").EntireColumn.AutoFit
Columns("A:W").VerticalAlignment = xlTop
Columns("B:B").Select
    Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Application.ScreenUpdating = True
Sheets("test").Select
    Application.ActivePrinter = "PDFCreator sur Ne00:"
    ExecuteExcel4Macro _
    "PRINT(1,,,1,,,,,,,,2,""PDFCreator sur Ne00:"",,TRUE,,FALSE)"
End Sub
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 688
11 janv. 2013 à 21:50
Pour qu'il n'y ait pas de souci dans ton code, avant le "end if" if faudrait enlever le code erreur :

else
       err.clear
end if
0
elglouton Messages postés 189 Date d'inscription dimanche 19 avril 2009 Statut Membre Dernière intervention 11 novembre 2022 1
12 janv. 2013 à 11:32
Merci encore bon week end ça fonctionne nikel
mon code est un peu lourd mais ça tourne...
0