Alleger Code d'un Récap

Enzo_Vautor

XLDnaute Nouveau
Bjr, Désolé je rame depuis le début des vacances pour finaliser un fichier excel pour le taf histoire de me faciliter a vie, c'est plus devenu une rixe entre moi et excel pour réussir a le dompter qu'un outils xD

Enfin BREF,
voila j'aimerais savoir si en final de compte vous pourriez m'aider pour alleger les codes de mon gros bébé

Ci joint le GROS Bébé

Cordialement,
Enzo Vautor
 

Pièces jointes

  • Récap TRANSPORT AOUT 2012.zip
    254 KB · Affichages: 51
  • Récap TRANSPORT AOUT 2012.zip
    254 KB · Affichages: 51
  • Récap TRANSPORT AOUT 2012.zip
    254 KB · Affichages: 48

MichD

XLDnaute Impliqué
Re : Alleger Code d'un Récap

Bonjour,

Voici un exemple de code qui prend toutes les données de toutes les feuilles du classeur
peu importe où leur localisation dans chacune des feuilles et les reporte dans la feuille
nommée "recap".

J'ai supposé que sur chaque feuille, la première ligne (les étiquettes de colonnes) était la même.


VB:
Sub test()
Dim Sh As Worksheet, Rg As Range, Rg1 As Range
Dim DerLig As Long, DerCol As Integer
Dim PremLig  As Long, PremCol As Integer, X As Long

Application.ScreenUpdating = False
'Efface le contenu de la feuille recap
Worksheets("Recap").Cells.Clear

For Each Sh In ThisWorkbook.Worksheets
    If UCase(Sh.Name) <> "recap" Then
        With Sh
            If Not IsEmpty(.UsedRange) Then
                Depart = .Cells(.Rows.Count, .Columns.Count).Address
                'Trouve la première ligne occupée
                PremLig = .Cells.Find(What:="*", _
                                After:=.Range(Depart), _
                                LookIn:=xlValues, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext).Row
                'Trouve la dernière occupée dans la feuille
                DerLig = .Cells.Find(What:="*", _
                                LookIn:=xlValues, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious).Row
                'Trouve la dernière colonne de la feuille
                DerCol = .Cells.Find(What:="*", _
                                LookIn:=xlValues, _
                                SearchOrder:=xlByColumns, _
                                SearchDirection:=xlPrevious).Column

                'Trouve la première colonne de la feuille
                PremCol = .Cells.Find(What:="*", _
                                After:=.Range(Depart), _
                                LookIn:=xlValues, _
                                SearchOrder:=xlByColumns, _
                                SearchDirection:=xlNext).Column
                
                'Rg est une variable de type "Range" qui représente
                'la plage à copier dans la feuille recap.
                Set Rg = .Range(.Cells(PremLig, PremCol), .Cells(DerLig, DerCol))
            End If
        End With
        With Worksheets("recap")
            X = .Cells(.Rows.Count, 1).End(xlUp).Row
            If X <> 1 Then
                 X = X + 1
                 Set Rg = Rg.Offset(1).Resize(Rg.Rows.Count - 1)
            End If
            Rg.Copy .Range("A" & X)
        End With
    End If
Next
Application.ScreenUpdating = True
End Sub
 

Statistiques des forums

Discussions
312 496
Messages
2 088 980
Membres
103 997
dernier inscrit
SET2A