pb de boucle sur condition d'existence d'onglet

superbog

XLDnaute Occasionnel
Bonjour,

J'ai un classeur avec un onglet HD qui sert de source pour créer des factures (en utilisant la colonne B qui porte les numéros des dossiers), un onglet facture pour lister les factures faites et des onglets dossier (chacun porte le numéro du dossier).

J'ai créé une macro qui me permet d'éditer des factures à condition
  • que l'onglet existe
  • que le dossier porte un numéro >9000
  • que la facture n'ait pas déjà été faite

Or la première condition, concernant l'onglet, ne fonctionne pas, notamment en boucle...

Voici la macro

Code:
Sub fact_test()

Dim i, t, DerLigBase, lig As Integer
Dim dossier, sNomFeuille As String
Dim colFeuille As Collection
Dim FeuilleExist As Boolean
Dim shAct As Worksheet, F As Worksheet, sh1 As Worksheet, Sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet, sh5 As Worksheet
Dim nomNewClasseur As String
Dim Numfacture As Long

lig = Sheets("HR").range("B9000").End(xlUp).Row + 1

'Recherche de la dernière ligne
DerLigBase = Sheets("HR").range("A9000").End(xlUp).Row

Set sh1 = ThisWorkbook.Sheets("Facture")
Set Sh2 = ThisWorkbook.Sheets("fact")
Set sh3 = ThisWorkbook.Sheets("HR")

Set colFeuille = New Collection

On Error Resume Next
   
sh3.Activate
    'Recherche de la ligne et tri dans chaque feuille
    
For i = 2 To Sheets("HR").range("B9000").End(xlUp).Row

    'Récupère le nom de l'onglet stocké dans la collection
    sNomFeuille = Cells(i, 2).Text
    'Recherche si cet onglet existe

Set F = Sheets(sNomFeuille)
 If F Is Nothing Then GoTo 100
 If Sheets("HR").Cells(i, 2) > 9000 Then GoTo 100
  If Not IsEmpty(Sheets("HR").Cells(i, 6)) And IsEmpty(Sheets("HR").Cells(i, 9)) Then
              Sheets("Facture").range("A9") = Sheets("HR").Cells(i, 2)
              Sheets("Facture").range("D35") = Sheets("HR").Cells(i, 4)
              Sheets("Facture").range("E35") = "par " & Sheets("HR").Cells(i, 5)
              Sheets("Facture").range("F35") = Sheets("HR").Cells(i, 6)
              Sheets("HR").Cells(i, 9) = "F"
         'incrémente le numéro de facture

             Numfacture = Sheets("facture").range("F1").Value
             Numfacture = Numfacture + 1
             Sheets("facture").range("F1").Value = Numfacture
 
             Sheets("Facture").Activate
           
           
'enregistre la facture en pdf

nomNewClasseur = range("F1") & "F -" & range("F9") & "-" & range("A9") & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\Brigitte\Dropbox\PARIS VM\factures\" & nomNewClasseur, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, from:=1, To:=1, OpenAfterPublish:=False
    
Sh2.Cells(i, 2).Value = sh1.range("A9").Value
Sh2.Cells(i, 3).Value = sh1.range("B9").Value
Sh2.Cells(i, 4).Value = sh1.range("F2")
Sh2.Cells(i, 5).Value = sh1.range("F1").Value
Sh2.Cells(i, 6).Value = sh1.range("F21").Value
Sh2.Cells(i, 7).Value = sh1.range("F25").Value
Sh2.Cells(i, 8).Value = sh1.range("F23").Value
Sh2.Cells(i, 9).Value = sh1.range("F27").Value
          
          
          End If
 
100 Next i

MsgBox "factures terminées"

End Sub

ci joint un fichier exemple

Pourriez vous m'aider svp
 

Pièces jointes

  • testfacturesonglets.xlsm
    107.7 KB · Affichages: 31

Discussions similaires

Réponses
8
Affichages
908

Statistiques des forums

Discussions
311 709
Messages
2 081 754
Membres
101 812
dernier inscrit
trufu