FOR AVEC 2 CONDITIONS

las-dias

las-dias

XLDnaute Nouveau
Bonjour à tous :),
J'ai une macro qui ouvre des fichiers et supprime, soit la 2è ou la 3è feuille de chaque fichier enregistré dans un répertoire “J9”.

Avant la macro fonctionnait bien avec la 1è condition. Lorsque j'ai ajouté la 2è condition (VBA ci-dessous) la macro a cessé de fonctionner. (ci-joint une capture d’écran du message d'erreur).
J’ai essayé plusieurs exemple de VBA, mais sans succès.

Si vous me permettez, je vous transmets le VBA en question.
En vous souhaitant une bonne réception.
Cher internaute, je vous remercie à l'avance pour votre aide ;).

Code: 
Sub DELETE_SHEETS()

lastrow = Range("G" & Rows.Count).End(xlUp).Row
Wb = ThisWorkbook.Name
Dim objFolder As Object
Dim objFile As Object
Dim chemin As String


Set objFSO = CreateObject("Scripting.FileSystemObject")
chemin = Workbooks(Wb).Sheets("PARAMETRES").Cells(9, "J")
Set objFolder = objFSO.GetFolder(chemin)

For i = 10 To lastrow

'1ère condition:
If Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "G") = "OUI" And Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "A") = "RESEAU" Then

  For Each objFile In objFolder.Files
   If InStr(objFile.Name, Sheets("PARAMETRES").Cells(i, "B")) <> 0 Then
     LienFichier = chemin & "\" & objFile.Name
     ActiveWorkbook.FollowHyperlink Address:=(LienFichier)
     wb2 = objFile.Name
    
      Application.DisplayAlerts = False
  
            Workbooks(wb2).Sheets(3).Delete
                Workbooks(wb2).Save
                    Workbooks(wb2).Close
    
'2ème Condition: (que j'ai ajouté)
ElseIf Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "G") = "OUI" And Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "A") <> "RESEAU" Then
    
   For Each objFile In objFolder.Files
   If InStr(objFile.Name, Sheets("PARAMETRES").Cells(i, "B")) <> 0 Then
     LienFichier = chemin & "\" & objFile.Name
     ActiveWorkbook.FollowHyperlink Address:=(LienFichier)
     wb2 = objFile.Name
    
      Application.DisplayAlerts = False
            Workbooks(wb2).Sheets(2).Delete
                Workbooks(wb2).Save
                     Workbooks(wb2).Close
    
   End If
  Next objFile
End If

Next i

nombre = WorksheetFunction.CountIf(Range("G:G"), "OUI")
   MsgBox ("TERMINÉ : " & nombre & " ONGLETS EFFECES")

End Sub
 

Pièces jointes

  • Sans titre.png
    Sans titre.png
    37.3 KB · Affichages: 22
Trier par date Trier par votes
laurent950

laurent950

XLDnaute Accro
Bonsoir Manque
End If
et
Next objFile
VB: 
Sub DELETE_SHEETS()

lastrow = Range("G" & Rows.Count).End(xlUp).Row
Wb = ThisWorkbook.Name
Dim objFolder As Object
Dim objFile As Object
Dim chemin As String


Set objFSO = CreateObject("Scripting.FileSystemObject")
chemin = Workbooks(Wb).Sheets("PARAMETRES").Cells(9, "J")
Set objFolder = objFSO.GetFolder(chemin)

For i = 10 To lastrow

'1ère condition:
If Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "G") = "OUI" And Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "A") = "RESEAU" Then

    For Each objFile In objFolder.Files
        If InStr(objFile.Name, Sheets("PARAMETRES").Cells(i, "B")) <> 0 Then
            LienFichier = chemin & "\" & objFile.Name
                ActiveWorkbook.FollowHyperlink Address:=(LienFichier)
                wb2 = objFile.Name
   
            Application.DisplayAlerts = False
            Workbooks(wb2).Sheets(3).Delete
                Workbooks(wb2).Save
                    Workbooks(wb2).Close
        end if
    next objFile
'2ème Condition: (que j'ai ajouté)
ElseIf Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "G") = "OUI" And Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "A") <> "RESEAU" Then
   
    For Each objFile In objFolder.Files
        If InStr(objFile.Name, Sheets("PARAMETRES").Cells(i, "B")) <> 0 Then
            LienFichier = chemin & "\" & objFile.Name
                ActiveWorkbook.FollowHyperlink Address:=(LienFichier)
                wb2 = objFile.Name
   
            Application.DisplayAlerts = False
            Workbooks(wb2).Sheets(2).Delete
                Workbooks(wb2).Save
                     Workbooks(wb2).Close
   
        End If
    Next objFile
End If

Next i

nombre = WorksheetFunction.CountIf(Range("G:G"), "OUI")
   MsgBox ("TERMINÉ : " & nombre & " ONGLETS EFFECES")

End Sub
 
Vote positif 0 Vote négatif
las-dias

las-dias

XLDnaute Nouveau
CA MARCHE ;) !
JE VOUS REMERCIE BEAUCOUP.
Une petite question, je souhaite savoir est ce qu'il existe une ligne de code pour COMPTER le nombre des fichiers traités dans la boucle pour les 2 conditions.
Dans le code, j'ai mis : nombre = WorksheetFunction.CountIf(Range("G:G"), "OUI")
Mais ça ne compte pas le nombre réel des fichiers traités dans la boucle.
Est ce que vous avez une idée SVP ?
Merci encore pour votre aide.
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Accro
Comme cela,
VB: 
Sub DELETE_SHEETS()

lastrow = Range("G" & Rows.Count).End(xlUp).Row
Wb = ThisWorkbook.Name
Dim objFolder As Object
Dim objFile As Object
Dim chemin As String

' Nombre de fichier
' nombre = WorksheetFunction.CountIf(Range("G:G"), "OUI")
dim nombre as double : nombre = 0

Set objFSO = CreateObject("Scripting.FileSystemObject")
chemin = Workbooks(Wb).Sheets("PARAMETRES").Cells(9, "J")
Set objFolder = objFSO.GetFolder(chemin)

For i = 10 To lastrow

'1ère condition:
If Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "G") = "OUI" And Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "A") = "RESEAU" Then

    For Each objFile In objFolder.Files
        If InStr(objFile.Name, Sheets("PARAMETRES").Cells(i, "B")) <> 0 Then
            LienFichier = chemin & "\" & objFile.Name
                ActiveWorkbook.FollowHyperlink Address:=(LienFichier)
                wb2 = objFile.Name
  
            Application.DisplayAlerts = False
            Workbooks(wb2).Sheets(3).Delete
                Workbooks(wb2).Save
                    Workbooks(wb2).Close
            ' Nombre de fichier
            nombre = nombre + 1
        end if
    next objFile
'2ème Condition: (que j'ai ajouté)
ElseIf Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "G") = "OUI" And Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "A") <> "RESEAU" Then
  
    For Each objFile In objFolder.Files
        If InStr(objFile.Name, Sheets("PARAMETRES").Cells(i, "B")) <> 0 Then
            LienFichier = chemin & "\" & objFile.Name
                ActiveWorkbook.FollowHyperlink Address:=(LienFichier)
                wb2 = objFile.Name
  
            Application.DisplayAlerts = False
            Workbooks(wb2).Sheets(2).Delete
                Workbooks(wb2).Save
                     Workbooks(wb2).Close
            ' Nombre de fichier
            nombre = nombre + 1
        End If
    Next objFile
End If
Next i

'nombre = WorksheetFunction.CountIf(Range("G:G"), "OUI")
   MsgBox ("TERMINÉ : " & nombre & " ONGLETS EFFECES")

End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
las-dias

las-dias

XLDnaute Nouveau
Oui j'ai inclus votre VBA et ça a bien fonctionné ensuite, je vous remercie.
Si vous me permettez, je voudrais profiter toujours de l'occasion , j'ai une autre macro avec laquelle j'ai essayé à plusieurs reprises de faire la même choses, sans succès (compter le nombre du traitement dans la boucle).
J'ai essayé l'expression suivante, mais ça m'affiche un nombre bien supérieur au nombre traité.
MsgBox ("TERMINÉ : " & no_metier & " fichiers créés !")

Je vous la transmets si vous voulez bien accepter de la revoir s'il vous plait.

Code: 
Sub CREATION_N_FICHIER()
Dim no_fichier As Integer
no_fichier = 1

strCheminSource = ActiveWorkbook.FullName
lder = ThisWorkbook.Worksheets("PARA").Range("B" & Application.Rows.Count).End(xlUp).Row

derfichier = lder - 9 ' 9 car le tableau commence à partir de la 9è ligne 
Do While no_fichier< derfichier + 1
If Range("G" & no_metier + 9).Value = "OUI" Then

    Range("B1").Value = Range("B" & no_fichier + 9).Value
    Range("C1").Value = Range("C" & no_fichier + 9).Value
    Range("D1").Value = Range("D" & no_fichier + 9).Value
 
    Sheets(2).Name = Worksheets("PARA").Range("B1").Value

    chemin = Range("F3").Value & "\"
    strfichier = chemin & " - " & Range("B1").Value & ".xls"
    ActiveWorkbook.SaveAs Filename:=strfichier, FileFormat:=xlExcel8
   End If
    no_fichier= no_fichier+ 1
 
Loop

MsgBox (no_fichier & " fichiers créés !")
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Accro
Donc :
exemple :
Range("B" & no_metier + 9) = la position "no_metier" est le numéro de la ligne dans la colonne B
MsgBox ("TERMINÉ : " & no_metier & " fichiers créés !")

ici le compteur :
no_fichier= no_fichier+ 1

Soit :
MsgBox ("TERMINÉ : " & no_fichier & " fichiers créés !")

Laurent
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Accro
las-dias à dit:
If Range("G" & no_metier + 9).Value = "OUI" Then

Range("B1").Value = Range("B" & no_fichier + 9).Value
Cliquez pour agrandir...

no_metier ?
no_fichier + 9 ?

Je m'excuse, j'ai fait des erreurs dans le dernier code : il y a que "no_fichier"
Je viens de corriger à l'instant le VBA précédent que je vous ai adressé.
Par contre, je n'ai pas compris votre dernière réponse.

Il y a des erreurs dans le code certainement, mais la structure me semble corecte
garder = no_fichier + 9 est modifié (no_metier + 9 si mauvaise variable)
et
pour le compteur a la place de
no_fichier= no_fichier+ 1
noté
dim cpt as integer
cpt = cpt +1
MsgBox (cpt & " fichiers créés !")
 
Vote positif 0 Vote négatif
las-dias

las-dias

XLDnaute Nouveau
Désolé, il y a pas de "no_metier" dans le code, c'est "no_sport".

VB: 
Dim no_fichier As Integer
no_fichier = 1

strCheminSource = ActiveWorkbook.FullName
lder = ThisWorkbook.Worksheets("PARA").Range("B" & Application.Rows.Count).End(xlUp).Row

derfichier = lder - 9 ' 9 car le tableau commence à partir de la 9è ligne
Do While no_fichier< derfichier + 1
If Range("G" & no_metier + 9).Value = "OUI" Then

    Range("B1").Value = Range("B" & no_fichier + 9).Value
    Range("C1").Value = Range("C" & no_fichier + 9).Value
    Range("D1").Value = Range("D" & no_fichier + 9).Value
    Sheets(2).Name = Worksheets("PARA").Range("B1").Value

    chemin = Range("F3").Value & "\"
    strfichier = chemin & " - " & Range("B1").Value & ".xls"
    ActiveWorkbook.SaveAs Filename:=strfichier, FileFormat:=xlExcel8
   End If
    no_fichier= no_fichier+ 1
Loop

MsgBox (no_fichier & " fichiers créés !")
End Sub

D'accord je vous remercie pour votre réponse, mais est ce que je garde "no_fichier" partout dans le code, ou je la remplace par "cpt" ?
 
Vote positif 0 Vote négatif
las-dias

las-dias

XLDnaute Nouveau
Bonjour,
Je reviens vers vous encore une fois, j'ai rajouté une 3è condition dans le VBA et j'ai le même soucis, ça blogue au niveau de "Next i".
Est ce que vous avez une idée de ce qu'il faut faire s'il vous plait ?

VB: 
Sub DELETE_SHEETS()

lastrow = Range("G" & Rows.Count).End(xlUp).Row
Wb = ThisWorkbook.Name
Dim objFolder As Object
Dim objFile As Object
Dim chemin As String

Dim nombre As Double: nombre = 0

Set objFSO = CreateObject("Scripting.FileSystemObject")
chemin = Workbooks(Wb).Sheets("PARAMETRES").Cells(9, "J")
Set objFolder = objFSO.GetFolder(chemin)

For i = 10 To lastrow

[B][COLOR=#0000ff]1er CONDITION:[/COLOR][/B]
If Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "G") = "OUI" And Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "A") = "AP" Then

  For Each objFile In objFolder.Files
 
   If InStr(objFile.Name, Sheets("PARAMETRES").Cells(i, "B")) <> 0 Then
     LienFichier = chemin & "\" & objFile.Name
     ActiveWorkbook.FollowHyperlink Address:=(LienFichier)
     wb2 = objFile.Name
    
      Application.DisplayAlerts = False
   
            Workbooks(wb2).Sheets(2).Delete 'SUPP CDRM ABR
            Workbooks(wb2).Sheets(3).Delete 'SUPP CDRM Autres métiers ABR
                Workbooks(wb2).Save
                    Workbooks(wb2).Close
      
       nombre = nombre + 1
     
      End If
    Next objFile
     
[B][COLOR=#0000ff]2è CONDITION:[/COLOR][/B]
If Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "G") = "OUI" And Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "A") = "ABR" Then
     
   For Each objFile In objFolder.Files
 
   If InStr(objFile.Name, Sheets("PARAMETRES").Cells(i, "B")) <> 0 Then
     LienFichier = chemin & "\" & objFile.Name
     ActiveWorkbook.FollowHyperlink Address:=(LienFichier)
     wb2 = objFile.Name
    
      Application.DisplayAlerts = False
            Workbooks(wb2).Sheets(3).Delete 'SUPP CDRM AP
            Workbooks(wb2).Sheets(3).Delete 'SUPP CDRM Autres métiers ABR
                Workbooks(wb2).Save
                     Workbooks(wb2).Close
                    
       nombre = nombre + 1
     
      End If
    Next objFile
   
3[B][COLOR=#0000ff]è CONDITION:[/COLOR][/B]
   ElseIf Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "G") = "OUI" And Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "A") = "AUTRE_ABR" Then
     
   For Each objFile In objFolder.Files
 
   If InStr(objFile.Name, Sheets("PARAMETRES").Cells(i, "B")) <> 0 Then
     LienFichier = chemin & "\" & objFile.Name
     ActiveWorkbook.FollowHyperlink Address:=(LienFichier)
     wb2 = objFile.Name
    
      Application.DisplayAlerts = False
            Workbooks(wb2).Sheets(2).Delete 'SUPP CDRM ABR
            Workbooks(wb2).Sheets(2).Delete 'SUPP CDRM AP
                Workbooks(wb2).Save
                     Workbooks(wb2).Close
                    
       nombre = nombre + 1
     
      End If
    Next objFile
   
   
  End If
[COLOR=#ff0000][B]Next i 'ici Message d'erreur : Next sans For[/B][/COLOR]


   MsgBox ("TERMINÉ : " & nombre & " ONGLETS EFFECES")

End Sub
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Accro
Bonsoir,
je ne peux pas vraiment savoir comme j'ai pas le fichier. C'est vous qui avait construit ce code, ou récupéré est adapté ?

par exemple Poste #9 vous écrivez cela : Désolé, il y a pas de "no_metier" dans le code, c'est "no_sport".
puis vous poster le code.

J'ai pas trouvé ?
 
Vote positif 0 Vote négatif
las-dias

las-dias

XLDnaute Nouveau
Bonsoir,
Problème du 1èr code est résolu :
VB: 
      End If
    Next objFile
  End If
  'dans chaque condition.

Je vous remercie !

Par contre dans le code ci-dessus, je souhaite savoir comment compter le nombre des fichiers crées dans la boucle SVP ?
"no_fichier" dans "MsgBox" ne m'affiche pas le bon nombre.
Je vous remercie d'avance pour votre aide.


VB: 
Dim no_fichier As Integer
no_fichier = 1

strCheminSource = ActiveWorkbook.FullName
lder = ThisWorkbook.Worksheets("PARA").Range("B" & Application.Rows.Count).End(xlUp).Row

derfichier = lder - 9 ' 9 car le tableau commence à partir de la 9è ligne
Do While no_fichier< derfichier + 1
If Range("G" & no_metier + 9).Value = "OUI" Then

    Range("B1").Value = Range("B" & no_fichier + 9).Value
    Range("C1").Value = Range("C" & no_fichier + 9).Value
    Range("D1").Value = Range("D" & no_fichier + 9).Value
    Sheets(2).Name = Worksheets("PARA").Range("B1").Value

    chemin = Range("F3").Value & "\"
    strfichier = chemin & " - " & Range("B1").Value & ".xls"
    ActiveWorkbook.SaveAs Filename:=strfichier, FileFormat:=xlExcel8
   End If
    no_fichier= no_fichier+ 1
Loop

MsgBox (no_fichier & " fichiers créés !")
End Sub
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Accro
Bonsoir,
VB: 
Dim no_fichier As Integer
    no_fichier = 0

strCheminSource = ActiveWorkbook.FullName
lder = ThisWorkbook.Worksheets("PARA").Range("B" & Application.Rows.Count).End(xlUp).Row

derfichier = lder - 9                                                 ' 9 car le tableau commence à partir de la 9è ligne
    Do While no_fichier< derfichier + 1
        If Range("G" & no_metier + 9).Value = "OUI" Then
            Range("B1").Value = Range("B" & no_fichier + 9).Value
            Range("C1").Value = Range("C" & no_fichier + 9).Value
            Range("D1").Value = Range("D" & no_fichier + 9).Value
            Sheets(2).Name = Worksheets("PARA").Range("B1").Value

            chemin = Range("F3").Value & "\"
            strfichier = chemin & " - " & Range("B1").Value & ".xls"
            ActiveWorkbook.SaveAs Filename:=strfichier, FileFormat:=xlExcel8
            no_fichier= no_fichier + 1
        End If 
    Loop

MsgBox (no_fichier & " fichiers créés !")
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2016 Boucle sur sous répertoire fso.GetFolder SharePoint
Réponses
0
Affichages
260
Aldonanou
A
C
  • Question
Autres bug sur une procédure avec textbox contenant un code barre
2
Réponses
15
Affichages
622
TooFatBoy
TooFatBoy
A
  • Question
Microsoft 365 Cpier/coller en VBA
Réponses
7
Affichages
419
A-F
A
G
  • Question
Microsoft 365 Incompatibilité de type - Array
Réponses
2
Affichages
215
guiyom
G
J
  • Question
XL 2019 Boucle for dans boucle for
2
Réponses
26
Affichages
2 K
Dranreb
Dranreb
A
  • Question
Microsoft 365 VBA: importer dans un dossier avec un nom variable
Réponses
4
Affichages
737
A-F
A
M
  • Question
XL 2016 Erreur d'execution '52': Nom ou numéro de fichier incorrect
Réponses
4
Affichages
535
macseb
M
R
  • Question
envoi mail avec pièce jointe
Réponses
1
Affichages
2 K
fanch55
fanch55
S
  • Question
Microsoft 365 Publipostage de masse avec pièce jointe personnalisé avec outlook
Réponses
1
Affichages
5 K
Sebast6945
S
C
  • Résolu(e)
XL 2010 supprimer une ligne sur d'autre feuilles en prenant référence sur une feuille journal
Réponses
3
Affichages
399
ccia
C

Membres actuellement en ligne

20 membres et 428 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 094
Messages
2 085 244
Membres
102 834
dernier inscrit
nadusha