Réaliser une boucle sur les colonnes

Bonjour

J'ai réalisé une macro qui permet d'ouvrir plussieurs fichiers et ainsi déterminer le nb de lignes dans chaque fichier.

Maintenant pour chaque fichier, je veux déterminer le nb de lignes par rapport à différents critères indiqués en colonne.

Je n'arrive pas à faire ma boucle dessus.

Ci-dessous ma macro déjà réalisé, le but est d'éviter d'écrire 21 fois la même chose en décalant à chaque fois la colonne

pouvez-vous m'aider

Application.CutCopyMode = False
Application.DisplayAlerts = False

Sheets("nb de virt détail").Select
Cells.Select

chemin = Range("I1")
compte = Range("b7")

Set class_princ = Workbooks("recupération_virements.xlsm")

nom_fic = Dir(chemin & "\*.xlsx")
ligne_liste = 8
ligne_fichiers = 8

Do While nom_fic <> ""
nblignes = 0
Workbooks.Open Filename:=chemin & "\" & nom_fic

Sheets("A").Select
Columns("D:D").Select
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
TrailingMinusNumbers:=True

nblignes = Application.WorksheetFunction.CountIf(Range("D1:D5000"), compte)

class_princ.Sheets("nb de virt détail").Range("A" & ligne_fichiers) = nom_fic
class_princ.Sheets("nb de virt détail").Range("b" & ligne_fichiers) = nblignes
ligne_fichiers = ligne_fichiers + 1
ActiveWorkbook.Close False
nom_fic = Dir
Loop

Application.CutCopyMode = False
Application.DisplayAlerts = False

Sheets("nb de virt détail").Select
Cells.Select

chemin = Range("I1")
compte = Range("c7")

Set class_princ = Workbooks("recupération_virements.xlsm")

nom_fic = Dir(chemin & "\*.xlsx")
ligne_liste = 8
ligne_fichiers = 8

Do While nom_fic <> ""
nblignes = 0
Workbooks.Open Filename:=chemin & "\" & nom_fic

Sheets("A").Select
Columns("D:D").Select
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
TrailingMinusNumbers:=True

nblignes = Application.WorksheetFunction.CountIf(Range("D1:D5000"), compte)

class_princ.Sheets("nb de virt détail").Range("A" & ligne_fichiers) = nom_fic
class_princ.Sheets("nb de virt détail").Range("c" & ligne_fichiers) = nblignes
ligne_fichiers = ligne_fichiers + 1
ActiveWorkbook.Close False
nom_fic = Dir
Loop

Edit : merci de mettre le code entre balises avec le bouton "</>"

Merci

Bonjour,

Voici un essai pour avoir le principe :

Sub perdreau()

dim wbprinc as workbook, wb as workbook
dim wsvirt as worksheet

Set wbprinc = Workbooks("recupération_virements.xlsm") 'thisworkbook (classeur executant)
set wsvirt = wbprinc.Sheets("nb de virt détail") 'feuille collage valeurs

with wsvirt

    chemin = .Range("I1")
    nom_fic = Dir(chemin & "\*.xlsx")
    ligne_fichiers = 8

    While nom_fic <> "" 'tant que fichiers
        set wb = Workbooks.Open(chemin & "\" & nom_fic) 'ouvre fichier et affecte wb
        wb.Sheets("A").Columns(4).TextToColumns Destination:=wb.Sheets("A").Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, Tab:=True, Semicolon:=True, _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
        TrailingMinusNumbers:=True 'redistribue colonnes ???? probablement plus simple !!!?
        
        for i = 1 to 21
            compte = .cells(7, i + 1) 'compte vaut B7 jusqua V7
            nblignes = Application.CountIf(wb.Sheets("A").Range("D1:D5000"), compte) 'nb lignes critère compte
            .Range("A" & ligne_fichiers) = nom_fic 'nom fichier
            .Range("b" & ligne_fichiers) = nblignes 'nb lignes critère
            .range("c" & ligne_fichiers) = compte 'critere
            ligne_fichiers = ligne_fichiers + 1 'incrémentation ligne_fichiers
        next i
         
        wb.Close False 'fermeture sans sauvegarde
        nom_fic = Dir 'fichier suivant
    wend
end with

end sub

Pour poster du code, vous pouvez utiliser les balises </> sur le ruban de commentaire.

Cdlt,

Rechercher des sujets similaires à "realiser boucle colonnes"