Regrouper plusieurs tableau dans un seul

Le 29/06/2010 à 11:08

Re-,

Euh

Chez moi, les fichiers sont les uns en dessous des autres....

Colle le code que tu as mis ici

Le 29/06/2010 à 11:14

Bonjour

Voici le code que j ai mis.

Sub Regroupe()

Dim Repertoire As String

Dim SousRépertoire As String

Dim DerCell As Range

Application.ScreenUpdating = False

SousRépertoire = "Lesfichiers"

[A2].CurrentRegion.Offset(1, 0).Clear

Repertoire = ThisWorkbook.Path & "\" & SousRépertoire

nf = Dir(Repertoire & "\*.csv")

Do While nf <> ""

Set DerCell = [A65000].End(xlUp)(2)

With ActiveSheet.QueryTables.Add(Connection:= _

"TEXT;" & Repertoire & "\" & nf, Destination:=DerCell)

.TextFileSemicolonDelimiter = True

.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _

1, 1, 1, 1)

.Refresh BackgroundQuery:=False

DerCell.EntireRow.Delete

End With

nf = Dir

Loop

End Sub

Merci d'avance

Le 29/06/2010 à 11:22

Re-,

On va donc y aller pas-à-pas...

rajoute cette ligne (en rouge):

    Set DerCell = [A65000].End(xlUp)(2)
    [color=#FF0000]DerCell.Select[/color]
    With ActiveSheet.QueryTables.Add(Connection:= _

Puis tu cliques sur F8, et en diminuant la taille de la fenêtre VBE (Visual Basic Editor), regarde si on vient bien sélectionner la première cellule vide de la colonne A

Le 29/06/2010 à 11:35

Bonjour,

Desole mais la j'ai pas compris ce que tu voulauis que je fasse

Amicalememnt

Axel

Le 29/06/2010 à 11:40

Re-,

Colle ce code, à la place de l'ancien

Puis tu cliques sur F8, afin de faire dérouler le code en mode pas-à-pas

Pour voir ce qu'il se passe sur la feuille, tu diminues la taille de la fenêtre de code, et tu appuies à suivre sur F8

Regarde si juste après la ligne rajoutée, la première cellule vide de la colonne A est bien sélectionnée

Edit, zut, oublié de mettre le nouveau code :

Sub Regroupe()
Dim Repertoire As String
Dim SousRépertoire As String
Dim DerCell As Range
Application.ScreenUpdating = False
SousRépertoire = "Essai texte"
[A2].CurrentRegion.Offset(1, 0).Clear
Repertoire = ThisWorkbook.Path & "\" & SousRépertoire
nf = Dir(Repertoire & "\*.csv")
Do While nf <> ""
    Set DerCell = [A65000].End(xlUp)(2)
    DerCell.Select
    With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & Repertoire & "\" & nf, Destination:=DerCell)
        .TextFileSemicolonDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1)
        .Refresh BackgroundQuery:=False
        DerCell.EntireRow.Delete
    End With
    nf = Dir
Loop
End Sub
Le 29/06/2010 à 11:54

Bonjour,

J'ai copier le code (je lai seclionne puis CTRL+C)

Je suis rentre dans le module

J'ai Fais Ctrl+A

J'ai tout supprime

J'ai fais CRTL+V

mais ca ne fonctionne pas

-- 29 Juin 2010, 12:03 --

J'ai bien copier le nouveau code

j'ai appuye sur F8

La seule chose qui se passe c'est que les ligne du code sont sur surlignees en jaune

Le 29/06/2010 à 12:03

Re-,

Est-ce que tu as déroulé le code en mode pas-à-pas, comme je te l'ai proposé plus haut?

En utilisant la touche de fonction F8...

regarde si la première cellule vide de la colonne A est bien sélectionnée à ce niveau ;

DerCell.Select

-- Mar Juin 29, 2010 8:06 pm --

Re-,

La seule chose qui se passe c'est que les ligne du code sont sur surlignees en jaune

Oui, effectivement, la ligne surlignée en jaune va être exécutée dès que tu appuieras de nouveau sur F8...

Diminue la taille de cette fenêtre, pour regarder ce qu'il se passe sur la feuille Excel, tout en continuant à appuyer sur F8

Le 29/06/2010 à 12:07

Re

Juste pour savoir : mon nouveau code n'est pas bon ?

Amicalement

Nad

Le 29/06/2010 à 12:10

Desole

je suis nul en programmation c'est quoi le mode pas-a-pas???

merci

Le 29/06/2010 à 12:13

Re-,

euh, je me demande si tu lis toutes mes réponses....

en appuyant sur F8, tu vas faire dérouler le code ligne par ligne

Pour cela, il faut appuyer plusieurs fois de suite, sur F8, la ligne jaune va descendre, et en même temps, la ligne que tu viens de quitter va s'exécuter....

Le 29/06/2010 à 12:21

En effet j'appuis sur la touche F8 et les ligne de mon code se surlignes en jaune.

Je regarde en meme temps que j'appuis sur "F8" mon tableau excel mais rien ne se passe

Le 29/06/2010 à 12:29

Re-,

je t'ai envoyé un message privé

-- Mar Juin 29, 2010 9:05 pm --

Re-,

Pour Nad

J'ai testé ton nouveau code, mais à l'ouverture, certaines données sont bien dispatcher dans les colonnes, et d'autres non...

aussi, lorsque tu déroule la dernière partie de ton code, qui correspondrait à un Données/Convertir, tu écrases les données qui sont dans les colonnes adjacentes (de B à H)

La méthode de requête que je lui propose n'a pas cet inconvénient, les données sont bien dispatcher dans les colonnes, mais je n'arrive pas à comprendre le souci qu'il a sur son fichier, sur le mien, tout se déroulant parfaitement...

A suivre

Le 30/06/2010 à 09:40

Bonjour,

mon probleme est reglé, voila comment j'ai procedé (c'est un peut de la bidouille et de la demerde)

J'ai enregistré mes 95 fichiers en .xls

et apres j'ai utilisé la formule suivante

Sub Regroupe()

sousRépertoire = "LesFichiers"

[A2].CurrentRegion.Offset(1, 0).Clear

Set maitre = ActiveWorkbook

Repertoire = ThisWorkbook.Path

nf = Dir(Repertoire & "\" & sousRépertoire & "\*.xls")

Do While nf <> ""

Workbooks.Open Filename:=Repertoire & "\" & sousRépertoire & "\" & nf

n = [A1].CurrentRegion.Rows.Count - 1

[A1].CurrentRegion.Offset(1, 0).Copy _

maitre.Sheets(1).[A65000].End(xlUp).Offset(1, 0)

ActiveWorkbook.Close False

nf = Dir

Loop

End Sub

Pour info le re-enregistrement en .xls prends environ 5 minutes et le regroupement des 95 fichiers prend environ 1 minute.

Merci encore de votre aide cruciale

Bien cordialment

Axel

Le 30/06/2010 à 22:30

Bonjour à tous,

Tu ne dis pas si le code de cousinhub marche, mais bon...

En gardant l'extension en csv des fichiers, une solution avait été trouvée ici : https://forum.excel-pratique.com/excel/concatener-fichiers-csv-t15500.html?hilit=csv

Combiné au code de nad, ça donnerait ça (avec la déclaration des variables en plus) :

Sub Regroupe()
Dim sousRépertoire As String, nf As String, Repertoire As String
Dim n As Long
Dim maitre As ThisWorkbook
Application.ScreenUpdating = False
sousRépertoire = "LesFichiers"
[A2].CurrentRegion.Offset(1, 0).Clear
Set maitre = ActiveWorkbook
Repertoire = ThisWorkbook.Path
nf = Dir(Repertoire & "\" & sousRépertoire & "\*.csv")
Do While nf <> ""
Name nf As Left(nf, Len(nf) - 3) & "txt"
        nf = Left(nf, Len(nf) - 3) & "txt"
        Workbooks.OpenText Filename:=Repertoire & "\" & sousRépertoire & "\" & nf, Origin:=xlWindows, _
                           StartRow:=1, DataType:=xlDelimited, Semicolon:=True
n = [A1].CurrentRegion.Rows.Count - 1
[A1].CurrentRegion.Offset(1, 0).Copy _
maitre.Sheets(1).[A65000].End(xlUp).Offset(1, 0)
ActiveWorkbook.Close False
Name nf As Left(nf, Len(nf) - 3) & "csv"
nf = Dir
Loop
End Sub

Explication : L'ouverture par vba des csv ne semble pas marcher comme une ouverture manuelle. Les csv sont donc renommés en texte pour pouvoir prendre les séparations en compte puis renommés à la fin en csv à nouveau.

Le 17/04/2015 à 14:17

Bj

J'aurais la même question mais cette fois pour regrouper plusieurs tableaux (ayant la même structure) situés dans des feuillets d'un même classeur, dans un même feuillet (avec mise à jour automatique si c'est possible)

Rechercher des sujets similaires à "regrouper tableau seul"