Coipier et concatener 23 feuilles dans un autre fichier

lematou

XLDnaute Occasionnel
Bonjour à tous,

J'ai un fichier avec les en-têtes de mes colonnes, il s'appelle "résultat" et n'a qu'une feuilles de calcul.
J'ai 23 fichiers Excel dans un même dossier, chacun n'ayant qu'une feuille et ils ont tous le même nombre de colonnes et les même en-têtes. mais pas le même nombre de lignes.
Ces fichiers portent des noms simples : MH_1, MH_2, MH_3,........,MH_23.
Je voudrais copier les données de chaque fichier et les concatener à la suite sur mon fichier résultat dans sa première et unique feuille.
Comme je dois faire cela 3 fois par semaine, je me demande s'il existe une solution en VBA.
J'ai déja fait une macro simple pour appeler le premier fichier, le copier et le coller dans ma feuille "résultat" mais je ne sais pas comment dire à excel de coller le deuxième fichier à la première ligne vide à la suite du premier, ni comment faire une boucle pour ne pas refaire l'opération 23 fois.
Quelqu'un peut-il m'aider. Merci beaucoup
 

flyonets44

XLDnaute Occasionnel
Re : Coipier et concatener 23 feuilles dans un autre fichier

Bonsoir
il faut que pour chaque feuille tu calcules la position de la dernière ligne occupée avec un code comme celui-ci
tu rajoutes ce code ci après
Dim K as long, Fichier as variant
K = Cells(65536, 1).End(xlUp).Row+1 '1 pour l'adresse de la première cellule vide
'Pour un boucle
For fichier = "Mh_1.xls"to "Mh_23.xls
Workbooks.Open Filename:=fichier
le reste de ton code pour copier
'fermeture du fichier source
Workbooks(fichier).Close savechanges:=false
next fichier
Boncourage
Flyonets
 

phlaurent55

Nous a quittés en 2020
Repose en paix
Re : Coipier et concatener 23 feuilles dans un autre fichier

Bonjour à tous,

voir fichier joint

à+
Philippe

Édit: Bonjour Kiki
 

Pièces jointes

  • 111.xls
    40.5 KB · Affichages: 160
  • 111.xls
    40.5 KB · Affichages: 153
  • 111.xls
    40.5 KB · Affichages: 147

CBernardT

XLDnaute Barbatruc
Re : Coipier et concatener 23 feuilles dans un autre fichier

Bonsoir à tous,

Un code effectué avec les données connues du projet :

Sub ReportDonnees()
Dim Chemin As String, Classeur As String, Fichier As String, Derlig As Integer, i As Byte, Tablo
' Effacement du report précédent
With Workbooks("Résultat.xls")
With Sheets("Resultats")
Derlig = .Range("A65000").End(xlUp).Row
.Range("A2:D" & Derlig + 1).ClearContents
End With
End With
' Report des données des fichiers sources
Chemin = "C:\Users\Bernard\Documents\BrouillonXld\" ' Chemin du répertoire contenant les fichiers source
For i = 1 To 23 ' Boucle sur les 23 fichiers
' Création du nom des fichiers
Classeur = CStr("MH_" & i & ".xls")
Fichier = Chemin & Classeur
' Ouverture du fichier
On Error Resume Next
Workbooks.Open Filename:=Fichier
' Mise en tableau des données à reporter
If Err.Number = 0 Then
With Workbooks(Classeur)
With Sheets("Feuil1") ' Nom de la feuille contenant les données
Derlig = .Range("A65000").End(xlUp).Row
Tablo = .Range("A2:D" & Derlig)
End With
.Close ' Fermeture du fichier
End With
' Report dans le fichier "Résultat"
With Workbooks("Résultat.xls")
With Sheets("Resultats")
Derlig = .Range("A65000").End(xlUp).Row
.Cells(Derlig + 1, 1).Resize(UBound(Tablo, 1), UBound(Tablo, 2)) = Tablo
End With
End With
Else
MsgBox "Le classeur appelé " & Classeur & " est inexistant"
Exit Sub
End If
On Error GoTo 0
Next i
End Sub

Quelques explications car quelques paramètres seront à adapter :

1- Le chemin du répertoire contenant les fichers source est à mettre à jour dans la macro.
2- Les données des fichiers sources sont pour l'instant considérées présentes dans les 4 colonnes A:D avec un entête.
3- La feuille des fichiers sources comprenant les valeurs à reporter est appelée "Feuil1"
4- La boucle sur les fichiers sources est limité à 23 cycles.
5- En cas d'absence d'un classeur MH_x, un message alerte de son absence et la macro est stoppée.
 

lematou

XLDnaute Occasionnel
Re : Coipier et concatener 23 feuilles dans un autre fichier

Bonsoir et merci à tous,
J'ai testé plusieurs de vos réponses...J'arrive à des trucs pas mal mais je suis pas encore au point.
Je m'y remets demain pour essayer de trouver grace à votre aide...Je vous tiens au courant
A bientôt.
 

lematou

XLDnaute Occasionnel
Re : Coipier et concatener 23 feuilles dans un autre fichier

Bonsoir a vous tous

J'ai essayé plusieurs macros mais j'avoue ne pas y arriver.

Dans celle de CBernarT tous les fichiers s'ouvrent et se ferment mais rien ne se copie dans mon fichier RESULTAT.

J'ai 23 fichiers Excel dans un même dossier appelé "MES DONNEES", chacun n'ayant qu'une feuille nommée " TABLEAU" et ils ont tous le même nombre de colonnes et les même en-têtes. mais pas le même nombre de lignes.
Ces fichiers portent des noms simples : MH_1, MH_2, MH_3,........,MH_23.
Je voudrais copier les données de chaque fichier et les concatener à la suite sur mon fichier "RESULTAT"dans sa première et unique feuille appelée "résultats"

je donne ici la macro que j'ai faite inspirée très largement de CBernardT.
Où est l'erreur pour la copy??? Je sais que j'oublie de faire copy mais je sais pas où le mettre dans la macro


Sub ReportDonnees()
Dim Chemin As String, Classeur As String, Fichier As String, Derlig As Integer, i As Byte, Tablo
' Effacement du report précédent
With Workbooks("RESULTAT.xls")
With Sheets("Resultats")
Derlig = .Range("A65536").End(xlUp).Row
.Range("A2" & Derlig + 1).ClearContents
End With
End With
' Report des données des fichiers sources
Chemin = "C:\Documents and Settings\UNTEL\Bureau\ MES DONNEES\" ' Chemin du répertoire contenant les fichiers source
For i = 1 To 23 ' Boucle sur les 23 fichiers
' Création du nom des fichiers
Classeur = CStr("MH_" & i & ".xls")
Fichier = Chemin & Classeur
' Ouverture du fichier
On Error Resume Next
Workbooks.Open Filename:=Fichier
' Mise en tableau des données à reporter
If Err.Number = 0 Then
With Workbooks(Classeur)
With Sheets("TABLEAU") ' Nom de la feuille contenant les données
Derlig = .Range("A65536").End(xlUp).Row
Tablo = .Range("A2" & Derlig)
End With
.Close ' Fermeture du fichier
End With
' Report dans le fichier "Résultat"
With Workbooks("Résultat.xls")
With Sheets("Resultats")
Derlig = .Range("A65536").End(xlUp).Row
.Cells(Derlig + 1, 1).Resize(UBound(Tablo, 1), UBound(Tablo, 2)) = Tablo
End With
End With
Else
MsgBox "Le classeur appelé " & Classeur & " est inexistant"
Exit Sub
End If
On Error GoTo 0
Next i
End Sub
 

flyonets44

XLDnaute Occasionnel
Re : Coipier et concatener 23 feuilles dans un autre fichier

Bonjour
je ne suis pas sûr mais tu peux essayer de tester :
With Workbooks(Classeur).Sheets("TABLEAU") ' Nom de la feuille contenant les données
.activate
Derlig = .Range("A65536").End(xlUp).Row
Tablo = .Range("A2" & Derlig)
End With
.Close ' Fermeture du fichier
ensuite , il faut utiliser un nom de variable différent pour le calcul de la dernière ligne occupée
With Sheets("Resultats")
Klign = .Range("A65536").End(xlUp).Row
.Cells(klign+ 1, 1).Resize(UBound(Tablo, 1), UBound(Tablo, 2)) = Tablo
Cordialement
Flyonets
 

CBernardT

XLDnaute Barbatruc
Re : Coipier et concatener 23 feuilles dans un autre fichier

Bonjour à tous,

Dans la macro, il y a que dans les lignes de code :

1- .Range("A2:D" & Derlig + 1).ClearContents

2- Tablo = .Range("A2:D" & Derlig)

un émoticone remplace le texte ":d" , "d" en majuscule

Voir le fichier joint.

Les adaptations du code réalisées en fonction des objets de ta configuration sont correctes.
 

Pièces jointes

  • Résultat.xls
    24.5 KB · Affichages: 73
  • Résultat.xls
    24.5 KB · Affichages: 72
  • Résultat.xls
    24.5 KB · Affichages: 71

lematou

XLDnaute Occasionnel
Re : Coipier et concatener 23 feuilles dans un autre fichier

Bonjour à tous,

CBernardT je n'ai pas compris pourquoi je dois mettre "d" et "d" en majuscule??? Je débute et je ne suis pas brillant ,je pense que tu veux dire d'aller jusqu'à la colonne "D"?
Et ton fichier je ne le comprends pas.
Mais j'y retourne. Je vais bien finir par y arriver. MOn seul problème c'est que tout marche mais rien ne se copie dans ma feuille résultats.
Merci
 

flyonets44

XLDnaute Occasionnel
Re : Coipier et concatener 23 feuilles dans un autre fichier

Bonjour
voici ton fichier avec ma solution; il suffira de remplacer le nom de mon fichier à ouvrir : fla par le nom de ton fichier à ouvrir
voir le code dans module 1
Cordialement
FLYONETS
 

Pièces jointes

  • Rbis.xls
    37.5 KB · Affichages: 66

lematou

XLDnaute Occasionnel
Re : Coipier et concatener 23 feuilles dans un autre fichier

Bonsoir à tous,
Merci Flyonets44 et merci à CbernardT!!!! Je viens de trouver et ça marche impécable.....Enfin c'est grace à vous quand même.
Je vous remercie beaucoup.
Est-ce que je dois cloturer la discussion? et dire que c'est résolu?
Merci ,vraiment
A bientôt.
 

flyonets44

XLDnaute Occasionnel
Re : Coipier et concatener 23 feuilles dans un autre fichier

Bonjour voici du code faisant le même travail que le fichier précédent, mais en utilisant un tableau

'import de donnés d'un classeur vers un autre classeur
Sub GetDataFromWorkbook()
Dim Wb As Workbook, Yl&, Zc&, Tablo, Cv
Dim Chemin$, Nomf As String, Fich
Dim Nbl&, Nbc&
'RÉCUPÉRATION DE X LIGNES ET Y Colonnes, Nbres à définir
Nbl = 30: Nbc = 5
ReDim Tablo(1 To Nbl, 1 To Nbc)
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'raz du traitement précédent
Feuil1.Cells.ClearContents
'identification du fichier à ouvrir
Chemin = ActiveWorkbook.Path & "\"
Fich = "FLA.xls"
Nomf = Chemin & Fich
Set Wb = Workbooks.Open(Nomf, True, True)
' Ouverture du fichier source en lecture seule
'et charge les datas de la feuille source dans le tablo
Yl = Range("A65000").End(xlUp).Row
Tablo = ActiveSheet.Cells(1, 1).Resize(Yl, Nbc).Value
' For Yl = 1 To Yl
' For Zc = 1 To 5
' Set Cv = Cells(Yl, Zc)
' Tablo(Yl, Zc) = Cv.Value
' Next
' Next
Wb.Close False ' Fermeture du fichier source sans sauvegarde
'Renvoi des datas vers la destination
With ThisWorkbook.Worksheets(1)
' For Yl = 1 To 30
' For Zc = 1 To 5
' Cells(Yl + 1, Zc) = Tablo(Yl, Zc)
' Next Zc
' Next Yl
'ou
Zc = Nbc
ActiveSheet.Cells(1, 1).Resize(Yl, Zc) = Tablo
'suppression des #N/A
Set Cv = Range("A1", Range("K65000"))
Cv.Replace What:="#N/A", _
Replacement:=vbNullString, LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False
End With
Set Cv = Nothing: Set Wb = Nothing
Erase tablo
Application.Calculation = xlCalculationAutomatic
End Sub
Bon courage
Cordialement
FLYONETS
 

Discussions similaires

Statistiques des forums

Discussions
312 782
Messages
2 092 070
Membres
105 180
dernier inscrit
Reidnal