Remede pour un bug

Bonsoir le forum

Sur mon fichier il y a une macro trouvé sur le net qui affiche le contenu d’une ligne TBL structuré selon la valeur de cellule K3 (cette valeur est le numéro de facture)

La macro fonctionne bien, mais il y a un problème la macro se bloque quand la cellule K3 est vide ce bug est au niveau de la ligne indiquée ci-dessous.

Malgré plusieurs tests mais sans réussite. Je souhaite une trouver une solution pour dépasser ce bu.

Voici la ligne ou se bloque la macro quant la cellule K3 est vide.

voici le code:

Sub Duplicata_Facture(ByVal control As IRibbonControl)    'afficher duplicata

Dim Sh2 As Worksheet, Sh4 As Worksheet
Dim xCol&, i&
Dim Cible As String
Dim xLig As Long

Application.ScreenUpdating = False

Set Sh2 = Sheets("archive_factures")        'Source         ==> Feuil2
Set Sh4 = Sheets("Duplicata_facture")       'Destination    ==> Feuil3

Sh4.Unprotect
Sh4.Range("C5:F8,D2,B18:F42,D44:D45").ClearContents
Sh4.Range("C3").MergeArea.ClearContents

xCol = 9

xLig = Evaluate("MATCH('Duplicata_facture'!K3,archive_factures!A1:A17,0)")

With Sh2
    Sh4.[C3] = .Range("A" & xLig).Value
    Sh4.[D2] = .Range("B" & xLig).Value
    Sh4.[C5] = .Range("C" & xLig).Value
    Sh4.[C6] = .Range("D" & xLig).Value
    Sh4.[C8] = .Range("E" & xLig).Value
    Sh4.[D44] = .Range("F" & xLig).Value
    Sh4.[D45] = .Range("G" & xLig).Value  

    For i = 18 To 42                        
        .Range(.Cells(xLig, xCol), .Cells(xLig, xCol + 4)).Copy
        Sh4.Range("B" & i & ":F" & i).PasteSpecial Paste:=xlPasteValues
        '''Sh4.Range("A" & i & ":E" & i).PasteSpecial Paste:=xlPasteValues
        xCol = xCol + 5
    Next i
    Call QRCodeDuplic
    Sh4.Range("K3").ClearContents
    Sh4.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With

Application.ScreenUpdating = True
End Sub

Merci pour votre aide

Cordialement

bonsoir le forum

Mon fichier est réduit au minimum.

Salut Jiba,

...comprends rien à cette programmation mais, bon...
Essaye ça, peut-être!?

With Sh2
    If Sh4.Range("K3") <> "" Then
        On Error Resume Next
        xLig = .Columns(1).Find(what:=Sh4.Range("K3").Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row
        If xLig > 0 Then
            Sh4.[C3] = .Range("A" & xLig).Value
            Sh4.[D2] = .Range("B" & xLig).Value
            Sh4.[C5] = .Range("C" & xLig).Value
            Sh4.[C6] = .Range("D" & xLig).Value
            Sh4.[C8] = .Range("E" & xLig).Value
            Sh4.[D44] = .Range("F" & xLig).Value
            Sh4.[D45] = .Range("G" & xLig).Value
            For i = 18 To 42
                .Range(.Cells(xLig, xCol), .Cells(xLig, xCol + 4)).Copy
                Sh4.Range("B" & i & ":F" & i).PasteSpecial Paste:=xlPasteValues
                xCol = xCol + 5
            Next i
        End If
        On Error GoTo 0
    End If
    ''''Sh4.Range("K3").ClearContents
    Sh4.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With

A+

Bonsoir à tous ,

Une autre manière de faire. Remplacez votre code par :

Sub Duplicata_Facture(ByVal control As IRibbonControl)   'afficher duplicata
Dim Sh2 As Worksheet, Sh4 As Worksheet, xCol&, i&, Cible As String, xLig As Long

   Application.ScreenUpdating = False
   Set Sh2 = Sheets("archive_factures")      'Source       ==> Feuil2
   Set Sh4 = Sheets("Duplicata_facture")      'Destination   ==> Feuil3

   Sh4.Unprotect
   Sh4.Range("C5:F8,D2,B18:F42,D44:D45").ClearContents
   Sh4.Range("C3").ClearContents

   xCol = 9
   xLig = Application.IfError(Application.Match(Sh4.Range("k3"), Sh2.Columns(1), 0), 0)
   If xLig = 0 Then
     MsgBox "<" & Sh4.Range("k3") & "> n'est pas un numéro de facture connu.", vbCritical
   Else
     With Sh2
        Sh4.[C3] = .Range("A" & xLig).Value
        Sh4.[D2] = .Range("B" & xLig).Value
        Sh4.[C5] = .Range("C" & xLig).Value
        Sh4.[C6] = .Range("D" & xLig).Value
        Sh4.[C8] = .Range("E" & xLig).Value
        Sh4.[D44] = .Range("F" & xLig).Value
        Sh4.[D45] = .Range("G" & xLig).Value
        For i = 18 To 42
           .Range(.Cells(xLig, xCol), .Cells(xLig, xCol + 4)).Copy
           Sh4.Range("B" & i & ":F" & i).PasteSpecial Paste:=xlPasteValues
           xCol = xCol + 5
        Next i
     End With
   End If
   Sh4.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
   Application.ScreenUpdating = True
End Sub

bonjour chindou,

complèments de cow18

Bonjour le forum, bonjour curulis, bonjour mafraise, bonjour BsAlv

merci pour vos réponses rapide et pour ces solutions, tout fonctionne
parfaitement, les deux codes correspond bien à mes besoins.

BsAlv, concernant Cow18 mon inscription au forum que je ne connait pas avant a été avec le sujet posté c'est a dire nouveau membre

en plus j'ai perdu le mot de passe pour se connecter et remercier cow18 malgré que j'ai essayé le code avant sa réponse mais sans réussite.

xlig = Evaluate("IFERROR(MATCH('Duplicata_facture'!K3,'archive_factures'!A1:A17,0),0)")
If xlig = 0 Then MsgBox "erreur": Exit Sub

vs

 xLig = Application.IfError(Application.Match(Sh4.Range("k3"), Sh2.Columns(1), 0), 0)
   If xLig = 0 Then
     MsgBox "<" & Sh4.Range("k3") & "> n'est pas un numéro de facture connu.", vbCritical
 

la première ligne n'est pas tout à fait la même chose, (plage de 17 cellules au lieu d'une colonne complète) mais elle fait la même

bonjour BsAlv

J'ai tester votre code ça marche très bien, Merci bien

Oui j'ai compris, J'ai choisi la ligne de la colonne complète

Bonne soirée

bonsoir le forum.

sur la même question si on veut avancer un peu

pourquoi passer par le combobox puis la cellule qui prend la valeur du combo? comment garder le même code mais utiliser la valeur du combo directement au lieu de la cellule K3.

Merci d'avance

Cordialement