Réaliser une boucle sur les colonnes
p
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
3
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,