Macro récap automatique (pb)

  • Initiateur de la discussion Initiateur de la discussion Bradvid
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Bradvid

XLDnaute Occasionnel
Bonjour,

J'ai plusieurs fichiers contenant le même tableau avec des informations différentes.
Ma macro fait un récap automatique en allant chercher les informations dans chaque fichier du dossier.
La voici :
Sub chercheFichiersFermesV03()
Dim X As Integer, nbFichiers As Integer, Y As Integer
Dim Tableau() As String
Dim Direction As String

Application.ScreenUpdating = False
Direction = Dir("D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\*.xls")

Do While Len(Direction) > 0
nbFichiers = nbFichiers + 1
ReDim Preserve Tableau(1 To nbFichiers)
Tableau(nbFichiers) = Direction
Direction = Dir()
Loop

If nbFichiers > 0 Then
Y = 6
For X = 1 To nbFichiers
If Tableau(X) <> ThisWorkbook.Name Then
With ActiveSheet
.Cells(Y, 1).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "A2"
.Cells(Y, 2).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "B2"
.Cells(Y, 3).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "C2"
.Cells(Y, 4).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "D2"
.Cells(Y, 5).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "E2"
.Cells(Y, 6).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "F2"
.Cells(Y, 7).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "G2"
.Cells(Y, 8).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "H2"
.Cells(Y, 9).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "I2"
.Cells(Y, 10).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "J2"
.Cells(Y, 11).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "K2"
.Cells(Y, 12).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "L2"
.Cells(Y, 13).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "M2"
.Cells(Y, 14).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "N2"
.Cells(Y, 15).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "O2"
.Cells(Y, 16).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "P2"
.Cells(Y, 17).Formula = "='D:\Commercial\" & Sheets("Recap").Range("E2").Value & "\[" & Tableau(X) & "]année 08" & "'!" & "Q2"


End With
Y = Y + 1
End If
Next X
End If

Application.ScreenUpdating = True
End Sub

Je voudrais que la macro s'arrête en fonction du nombre de lignes remplies dans chaque tableau. (le nombre de ligne peut être différent d'un fichier à l'autre.

Merci encore pour votre aide.
 
Re : Macro récap automatique (pb)

Bjr Bradvid
Bradvid à dit:
Je voudrais que la macro s'arrête en fonction du nombre de lignes remplies dans chaque tableau. (le nombre de ligne peut être différent d'un fichier à l'autre.


Dans le cas où la 1ère ligne de tous tes tableaux comporte les entêtes de colonnes

Code:
Dim NbLigne As Integer

    Sheets(".......").Select
    Range("A1").Select
    NbLigne = Selection.End(xlDown).Row [COLOR="red"][B]- 1[/B][/COLOR]

[COLOR="Blue"]If[/COLOR] NbLigne ... [COLOR="blue"]Then[/COLOR]
    ...
[COLOR="blue"]End If[/COLOR]

"NbLigne" : nombre de ligne de ton tableau (hors ligne de titre car j'ai mis -1

A adapter à ton cas
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
1
Affichages
180
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
479
Réponses
4
Affichages
177
Réponses
4
Affichages
461
Réponses
40
Affichages
3 K
Réponses
3
Affichages
665
Retour