Adaptation d'une macro selon ligne départ du fichier

Bonjour,

Je reviens vers vous encore une fois avec la fameuse macro de H2so4

    Sub Consolidation()

    Dim wsp As Worksheet, wsc As Worksheet, ws As Worksheet
    Dim wb As Workbook
    Dim dl As Long, ligne As Long, i As Long

        Application.ScreenUpdating = False
        Set wsp = Sheets("parametres") 'feuille contenant les fichiers à consolider et le nom à leur associer
        Set wsc = Sheets("sheet1") 'feuille de consolidation
        wsc.UsedRange.Offset(1, 1).Clear 'on efface le contenu de la feuille consolidation en gardant la ligne 1 et la colonne A
        dl = wsp.Cells(Rows.Count, 1).End(xlUp).Row 'nombre de fichiers à consolider
        ligne = 2 'ligne où placer la consolidation
        For i = 1 To dl 'on traite les fichiers à consolider
            Set wb = Workbooks.Open(wsp.Cells(i, 2)) 'ouverture du fichier
            Set ws = wb.Sheets(1) ' feuille à consolider
            dl = wb.Sheets(1).Cells(Rows.Count, "D").End(xlUp).Row - 21 'nombre de données à consolider
            If dl > 0 Then 'si données
                wsc.Cells(ligne, "B").Resize(dl, 1) = wsp.Cells(i, 1) 'nom de société associé au fichier
                wsc.Cells(ligne, "C").Resize(dl, 2).Value = ws.Cells(25, 1).Resize(dl, 2).Value 'copie colonnes C et D
                wsc.Cells(ligne, "G").Resize(dl, 1).Value = ws.Cells(25, 10).Resize(dl, 1).Value 'copie NE
                wsc.Cells(ligne, "I").Resize(dl, 1).Value = ws.Cells(25, 9).Resize(dl, 1).Value 'copie 0-30
                wsc.Cells(ligne, "J").Resize(dl, 1).Value = ws.Cells(25, 8).Resize(dl, 1).Value 'copie 31-60
                wsc.Cells(ligne, "K").Resize(dl, 1).Value = ws.Cells(25, 7).Resize(dl, 1).Value 'copie 61-90
                wsc.Cells(ligne, "L").Resize(dl, 1).Value = ws.Cells(25, 6).Resize(dl, 1).Value 'copie 90+
        With wsc.Cells(ligne, "H").Resize(dl, 1)
                    .Formula = "=sum('[" & ws.Parent.Name & "]" & ws.Name & "'!F25:I25)" 'Rajoute Tot échu
                    .Value = .Value
                End With
        With wsc.Cells(ligne, "F").Resize(dl, 1)    'Calcule le Tot encours
                    .FormulaR1C1 = "=rc[1]+rc[2]"
                    .Value = .Value
                End With
                ligne = ligne + dl 'ligne où placer la consolidation suivante
            End If
            wb.Close 'fermer fichier à consolider
        Next i 'fichier suivant
        MsgBox "traitement terminé"
    End Sub

J'ai adapter la macro à un autre type de fichier le problème est ici :

wsc.Cells(ligne, "G").Resize(dl, 1).Value = ws.Cells(25, 10).Resize(dl, 1).Value 'copie NE

Le "25" me permet de dire de prendre à partir de la ligne 25 dans mes fichiers.
Malheureusement certains de mes fichiers commence ligne 22 ou 29 par exemple comment pourrai-je adapter la macro pour qu'elle s'adapte automatiquement au point de départ du fichier ?

Merci d'avance pour vos réponses

Avec des recherches je suis tombé sur ce forum :
https://forum.excel-pratique.com/excel/vba-commencer-une-macro-a-partir-d-une-ligne-qui-varie-172495

Mais j'ai du mal à adapter la ligne

Dim Lig As Long

For Lig = 2 To 800
            If .Range("C" & Lig) = "C" Then DebLig = Lig: Exit For 'Cherche 1ère ligne avec "C"
        Next Lig

avec la ligne suivante

wsc.Cells(ligne, "G").Resize(dl, 1).Value = ws.Cells(25, 10).Resize(dl, 1).Value 'copie NE

Peut être en créant une macro qui va déplacer les lignes dans le 1er fichier, je vais essayer ça

Bonjour Parrish,

Les débuts variants que tu cherches à identifier ... est-ce de plages ordinaires ou de tableaux structurés ??

ric

bonjour,

essaie ceci

Dim Lig As Long

dl = wb.Sheets(1).Cells(Rows.Count, "D").End(xlUp).Row
(...)
For Lig = 2 To 800
            If .Range("C" & Lig) = "C" Then DebLig = Lig: Exit For 'Cherche 1ère ligne avec "C"
        Next Lig

avec la ligne suivante
nlc=dl-deblig+1 'nombre de lignes à copier, dl étant le numéro de ligne de la dernière cellule utilisée.
wsc.Cells(ligne, "G").Resize(nlc, 1).Value = ws.Cells(deblig, 10).Resize(nlc, 1).Value 'copie NE

Ric,

Il s'agit de tableau structuré (je pense) j'ai du mal à saisir la question

De la ligne 1 à 16 c'est toutes les infos et les montants à récupérer peuvent commencer de la ligne 17 à 30

H2so4,

Référence incorrect ou non qualifié

Sub Consolidation()

Dim wsp As Worksheet, wsc As Worksheet, ws As Worksheet
Dim wb As Workbook
Dim dl As Long, ligne As Long, i As Long, Lig As Long

    Application.ScreenUpdating = False
    Set wsp = Sheets("parametres") 'feuille contenant les fichiers à consolider et le nom à leur associer
    Set wsc = Sheets("sheet1") 'feuille de consolidation
    wsc.UsedRange.Offset(1, 1).Clear 'on efface le contenu de la feuille consolidation en gardant la ligne 1 et la colonne A
    dl = wsp.Cells(Rows.Count, 1).End(xlUp).Row 'nombre de fichiers à consolider
    ligne = 2 'ligne où placer la consolidation
    For i = 1 To dl 'on traite les fichiers à consolider
        Set wb = Workbooks.Open(wsp.Cells(i, 2)) 'ouverture du fichier
        Set ws = wb.Sheets(1) ' feuille à consolider
        dl = wb.Sheets(1).Cells(Rows.Count, "D").End(xlUp).Row
        For Lig = 2 To 800
        If .Range("C" & Lig) = "C" Then deblig = Lig: Exit For 'Cherche 1ère ligne avec "C"
        Next Lig
        nlc = dl - deblig + 1 'nombre de lignes à copier, dl étant le numéro de ligne de la dernière cellule utilisée.
            wsc.Cells(ligne, "B").Resize(dl, 1) = wsp.Cells(i, 1) 'nom de société associé au fichier
            wsc.Cells(ligne, "C").Resize(dl, 2).Value = ws.Cells(25, 1).Resize(dl, 2).Value 'copie colonnes C et D
            wsc.Cells(ligne, "G").Resize(nlc, 1).Value = ws.Cells(deblig, 10).Resize(nlc, 1).Value 'copie NE
            wsc.Cells(ligne, "I").Resize(dl, 1).Value = ws.Cells(25, 9).Resize(dl, 1).Value 'copie 0-30
            wsc.Cells(ligne, "J").Resize(dl, 1).Value = ws.Cells(25, 8).Resize(dl, 1).Value 'copie 31-60
            wsc.Cells(ligne, "K").Resize(dl, 1).Value = ws.Cells(25, 7).Resize(dl, 1).Value 'copie 61-90
            wsc.Cells(ligne, "L").Resize(dl, 1).Value = ws.Cells(25, 6).Resize(dl, 1).Value 'copie 90+
    With wsc.Cells(ligne, "H").Resize(dl, 1)
                .Formula = "=sum('[" & ws.Parent.Name & "]" & ws.Name & "'!F25:I25)" 'Rajoute Tot échu
                .Value = .Value
            End With
    With wsc.Cells(ligne, "F").Resize(dl, 1)    'Calcule le Tot encours
                .FormulaR1C1 = "=rc[1]+rc[2]"
                .Value = .Value
            End With
        End If
        wb.Close 'fermer fichier à consolider
    Next i 'fichier suivant
    MsgBox "traitement terminé"
End Sub

Bonjour Parrish,

Pour savoir si c'est un tableau structuré ... sélectionne une cellule au hasard dans ce tableau ...

Tout au haut des boutons de Excel ... un lien apparaît "Création de tableau" ... en sélectionnant une cellule en dehors de la zone ... ce lien disparaît ...

Donc si c'est un tableau structuré ...clic sur le "Création de tableau" ... tout à gauche de l'écran en haut... c'est indiqué : "Nom du tableau" ...

Est-ce que tu as un nom de tableau ?

A+

ric

Ric,
Du coup il n'y a pas de tableau structuré

Bonjour Parrish,

Sans fichier pour tester ... quelques corrections ...

Deux variables non déclaré et un "End IF" de trop

Sub Consolidation()

    Dim wsp As Worksheet, wsc As Worksheet, ws As Worksheet
    Dim wb As Workbook
    Dim dl As Long, ligne As Long, i As Long, Lig As Long
    Dim deblig As Integer, nlc As Integer                ''' nouvelles variables

    Application.ScreenUpdating = False
    Set wsp = Sheets("parametres") 'feuille contenant les fichiers à consolider et le nom à leur associer
    Set wsc = Sheets("sheet1") 'feuille de consolidation
    wsc.UsedRange.Offset(1, 1).Clear 'on efface le contenu de la feuille consolidation en gardant la ligne 1 et la colonne A
    dl = wsp.Cells(Rows.Count, 1).End(xlUp).Row 'nombre de fichiers à consolider
    ligne = 2 'ligne où placer la consolidation
    For i = 1 To dl 'on traite les fichiers à consolider
        Set wb = Workbooks.Open(wsp.Cells(i, 2)) 'ouverture du fichier
        Set ws = wb.Sheets(1) ' feuille à consolider
        dl = wb.Sheets(1).Cells(Rows.Count, "D").End(xlUp).Row
        For Lig = 2 To 800
            If ws.Range("C" & Lig) = "C" Then deblig = Lig: Exit For 'Cherche 1ère ligne avec "C"
        Next Lig
        nlc = dl - deblig + 1 'nombre de lignes à copier, dl étant le numéro de ligne de la dernière cellule utilisée.
        wsc.Cells(ligne, "B").Resize(dl, 1) = wsp.Cells(i, 1) 'nom de société associé au fichier
        wsc.Cells(ligne, "C").Resize(dl, 2).Value = ws.Cells(25, 1).Resize(dl, 2).Value 'copie colonnes C et D
        wsc.Cells(ligne, "G").Resize(nlc, 1).Value = ws.Cells(deblig, 10).Resize(nlc, 1).Value 'copie NE
        wsc.Cells(ligne, "I").Resize(dl, 1).Value = ws.Cells(25, 9).Resize(dl, 1).Value 'copie 0-30
        wsc.Cells(ligne, "J").Resize(dl, 1).Value = ws.Cells(25, 8).Resize(dl, 1).Value 'copie 31-60
        wsc.Cells(ligne, "K").Resize(dl, 1).Value = ws.Cells(25, 7).Resize(dl, 1).Value 'copie 61-90
        wsc.Cells(ligne, "L").Resize(dl, 1).Value = ws.Cells(25, 6).Resize(dl, 1).Value 'copie 90+
        With wsc.Cells(ligne, "H").Resize(dl, 1)
            .Formula = "=sum('[" & ws.Parent.Name & "]" & ws.Name & "'!F25:I25)" 'Rajoute Tot échu
            .Value = .Value
        End With
        With wsc.Cells(ligne, "F").Resize(dl, 1)    'Calcule le Tot encours
            .FormulaR1C1 = "=rc[1]+rc[2]"
            .Value = .Value
        End With
'''        End If        ' end if sans if , j'ai désactivé 
        wb.Close 'fermer fichier à consolider
    Next i 'fichier suivant
    MsgBox "traitement terminé"
End Sub

ric

Le fichier est confidentiel, je vais essayer de l'adapter pour qu'il ne le soit plus, demain après avoir tester la macro

Bonjour Ric,

Voici une erreur sur :
wsc.Cells(ligne, "G").Resize(nlc, 1).Value = ws.Cells(deblig, 10).Resize(nlc, 1).Value 'copie NE
Message : Erreur 1004, erreur définie par l'application ou l'objet

Voici le fichier de la macro avec les fichier d'extraction :

1fichier1.xlsx (11.63 Ko)
1fichier2.xlsx (12.62 Ko)
1macro-sx3.zip (205.82 Ko)

Bonjour Parrish,

Il y avait quelques coquilles ... c'est corrigé ...

Déroulement : ouverture du premier fichier ... trouver la dernière ligne "pas intéressante à importer" ... remonter de 1 ligne puis boucler en remontant pour trouver la 1re ligne contenant des données à extraire ... extraction ...

À la fin de l'extraction > il fallait trouver la première ligne vide de la colonne "B" de "Sheet1" afin de continuer à l'apport de données en dessous ...

Un pas-à-pas (touche F8) a permis de trouver rapidement les coquilles ...

Avec un fichier pour tester ... ça a facilité la compréhension du souci ...

A+

ric

1macro-sx3.xlsm (114.41 Ko)

Le problème semble résolu merci beaucoup, il reste cependant un problème la macro copie le total général et "Page 1/1"

Aurez t'il un moyen de dire à la macro d'exclure ces cellules ?

Bonjour Parrish,

Effectivement ... dès le départ ... tu mentionnais que la première lignes étaient variante ... j'avais oublié et je ne tenais compte que de la dernière ligne variante ...

Il a fallu aussi faire varier où lire les formules ...

Maintenant ... cela fonctionne bien ...

Trouver les première et dernière lignes pour ne copier que la bonne plage ...

A+

ric

3macro-sx4.xlsm (90.88 Ko)

Le problème du total général est réglé mais il en reste un, il ne prend pas en compte le dernier montant affiché, j'ai essayé de changer des valeurs dans la macro mais rien n'y fait

Bonjour Parrish,

Je viens de vérifier ...

Fichier1 ... 1re ligne = -1682.022
Fichier1 ... dernière ligne = 45.34

Fichier2 ... 1re ligne = -463.27
Fichier2 ... dernière ligne = -3716.40

Et ce sont les montants que je retrouve dans le fichier macro-sx4.xlsm aux lignes 2 et 60 pour le fichier1 ... et les lignes 61 et 158 pour le fichier2 ...

Ton fichier de travail qui contient les macros ... la première ligne vide est bien la ligne 2 ???

Car ici ... ça semble fonctionner correctement ...

ric

Bonjour Parrish,

Je viens de penser à la méthode de trouver la dernière ligne dans les fichiers sources ...

La dernière ligne est cherchée sur la colonne "D" du fichier source ... le souci ne viendrait-il pas de là ??

Il serait possible de chercher la dernière ligne sur plus d'une colonne et de comparer les résultats pour prendre la ligne la plus basse ...

ric

J'ai essayé de jouer sur le D de cette ligne est-ce le bon selon toi ?

 dl = wb.Sheets(1).Cells(Rows.Count, "D").End(xlUp).Row - 1

Le modifier à réduit le nombre de ligne mais n'a pas pris la ligne manquante

Rechercher des sujets similaires à "adaptation macro ligne depart fichier"