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 SubJ'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 NELe "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 NEPeut ê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 NERic,
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 SubBonjour 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 Subric
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 :
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
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
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 - 1Le modifier à réduit le nombre de ligne mais n'a pas pris la ligne manquante