assembler des fichiers dont le nombre de colonne est de 7

Version imprimable

Bonjour Merci à Mr Toulon pour sa réponse qui est très intéressante.

Pas hyper à l'aise avec les tableaux

Je tente de l'adapter pour assembler des fichiers dont le nombre de colonne est de 7

j'ai tenté

Code:

.Cells(v, 1).Resize(UBound(tablo, 7))

j'ai l"'erreur l'indice n'appartient pas à la sélection"

en gardant

Code:

.Cells(v, 1).Resize(UBound(tablo, 1))

Tous les fichiers sont bien compilés en un mais seule la colonne A est collée

Avez-vous une idée de la raison de mon blocage ?

ci dessous le code très peu modifié (j'ai tenté plusieurs variantes mais sans succès)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub import_analyse()
'Application.ScreenUpdating = False: Application.DisplayAlerts = False
Dim Fichier As String, Chemin As String, v As Long, tablo As Variant, Wb As Workbook, dernlig As Long
Chemin = "C:\Users\Host\Desktop\TABLo\"
Fichier = Dir(Chemin & "*.xlsx")
Do While Fichier <> ""
 
Set Wb = Workbooks.Open(Chemin & Fichier)
    dernlig = Cells(Rows.Count, 1).End(xlUp).Row  'ici tu detecte la ligne limite de ton tableau a copier
    tablo = Range("A1:" & "I" & dernlig) 'copie du tableau voulu dans la variable tablo
 
     Wb.Close False: Set Wb = Nothing 'ici tu ferme le classeur que tu viens d'ouvrir pour copier la plage desirée
        With Sheets(1)
        v = IIf(v < 1, 2, .Cells(Rows.Count, 1).End(xlUp).Row + 1) 'recherche de la premiere ligne de libre a la suite dans le classeur central
        .Cells(v, 1).Resize(UBound(tablo, 7)) = tablo 'maintenant on  place le tableau a partie de la cellule (v,1)en dimensionnant avec la dimention du (tablo)
        '.Cells(v, 2).Resize(UBound(tablo, 0)) = tablo 'maintenant on  place le tableau a partie de la cellule (v,1)en dimensionnant avec la dimention du (tablo)
        End With
Fichier = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

05/08/2015, 21h58
patricktoulon

re
bonjour

deja pour moi il y a un soucis avec ca

Code:

tablo = Range("A1:" & "I" & dernlig) 'copie du tableau voulu dans la variable tablo

et ca

Code:

Cells(v, 1).Resize(UBound(tablo, 7)) = tablo

tu met une plage de 9 colone et X ligne dans un tableaux

et tu veux la mettre dans un resize de 7 colonne et le meme nombre de ligne
apres pour le reste peut pas tester n'ayant pas ton environnement mais me parait correct!!

une petite remarque
le

Code:

While Fichier <> ""

met le pluto dans le loop
il est fort possible que le fait qu'il soit en amont genere une erreur mais de cela je n'en suis pas sur mais tout de meme met le avec le "loop"
Code:

1 2 3 do .reste du code ...... loop while fichier=""

Citation:

Envoyé par patricktoulon

bonjour
deja pour moi il y a un soucis avec ca
tu met une plage de 9 colone et X ligne dans un tableaux
et tu veux la mettre dans un resize de 7 colonne et le meme nombre de ligne

Merci pour ce retour !

Effectivement de A à I il y a 9 colonnes et non 7
:oops: ..

Je parviens finalement a mes fins avec cet "arrangement" bien que je pense ne pas utiliser le plein pouvoir d'un tableau vba et passer à côté de l'optimum.
par exemple : là J'ai X lignes et un nombre fixe de colonnes mais si j'avais eu des fichier dont les tableaux de données à compiler était à largeur variable (X colonnes) mon code ferait 30km
J'ai déplacé le loop while fichier="" comme recommandé.

Ci-dessous ma parade qui à cette heure ci me convient:weird: j'ai bien toute mes données compilées
J'ai attribué 9 "tablo" (1 par colonne à copier)
Toutefois je ne comprends pas pourquoi le "tablo" ne m'insère qu'une colonne de données alors que j'avais spécifié sa largeur de 9 colonnes (range de A à I ) et que j'avais gardé le resize à 9 également..
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 Sub import_analyse() 'Application.ScreenUpdating = False: Application.DisplayAlerts = False Dim Fichier As String, Chemin As String, v As Long, tablo As Variant, Wb As Workbook, dernlig As Long Chemin = "C:\Users\Host\Desktop\TABLo\" Fichier = Dir(Chemin & "*.xlsx") Do Set Wb = Workbooks.Open(Chemin & Fichier) dernlig = Cells(Rows.Count, 1).End(xlUp).Row 'ici tu detecte la ligne limite de ton tableau a copier tablo = Range("A1:" & "I" & dernlig) 'copie du tableau voulu dans la variable tablo tablo1 = Range("B1:" & "I" & dernlig) 'copie du tableau voulu dans la variable tablo tablo2 = Range("C1:" & "I" & dernlig) tablo3 = Range("D1:" & "I" & dernlig) tablo4 = Range("E1:" & "I" & dernlig) tablo5 = Range("F1:" & "I" & dernlig) tablo6 = Range("G1:" & "I" & dernlig) tablo7 = Range("H1:" & "I" & dernlig) tablo8 = Range("I1:" & "I" & dernlig) Wb.Close False: Set Wb = Nothing 'ici tu ferme le classeur que tu viens d'ouvrir pour copier la plage desirée With Sheets(1) ' voir pour remplacer le n° de tableau par variable? For i = 1 To 9 v = IIf(v < 1, 2, .Cells(Rows.Count, 1).End(xlUp).Row + 1) 'recherche de la premiere ligne de libre a la suite dans le classeur central 'format et données ok pour ne pas réiterer la recherche de la première ligne à chaque colonne .Cells(v, 1).Resize(UBound(tablo)) = tablo 'maintenant on place le tableau a partie de la cellule (v,1)en dimensionnant avec la dimentson du (tablo) .Cells(v, 2).Resize(UBound(tablo1)) = tablo1 .Cells(v, 3).Resize(UBound(tablo2)) = tablo2 .Cells(v, 4).Resize(UBound(tablo3)) = tablo3 .Cells(v, 5).Resize(UBound(tablo4)) = tablo4 .Cells(v, 6).Resize(UBound(tablo5)) = tablo5 .Cells(v, 7).Resize(UBound(tablo6)) = tablo6 .Cells(v, 8).Resize(UBound(tablo7)) = tablo7 .Cells(v, 9).Resize(UBound(tablo8)) = tablo8 '.Cells(v, 2).Resize(UBound(tablo, 0)) = tablo 'maintenant on place le tableau a partie de la cellule (v,1)en dimensionnant avec la dimention du (tablo) End With Fichier = Dir Loop While Fichier <> "" Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
Au passage certains de vos sujets (Let it Bee) m'ont rudement inspiré/aidé/chauffé pour d'autre projets !
(Extraction web via excel et vba (pas encore vbs mais je suis dessus :aie:) pour alimenter une base sql puis interface highcharts en web accès pour visualiser les données!
Alors je tenais à vous dire merci !

Bonjour,

Vous pouvez essayer ça pour éviter la multiplication des tableaux (testé et à adapter)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Test_ExportToTabl()
 
Dim InpRng As Range
Dim InpTabl() As Variant
 
Set InpRng = ThisWorkbook.Worksheets("Trsf_summary_2015").Range("A7").CurrentRegion   'Sheet et range du début à modifier
Debug.Print InpRng.Address, InpRng.Columns.Count, InpRng.Rows.Count
 
ReDim InpTabl(1 To InpRng.Columns.Count, 1 To InpRng.Rows.Count) 'Attention à bien commencer à 1, autrement voir l'option BASE mais dangereux!
 
InpTabl = InpRng.Value 'et ça marche!
 
End Sub

avec ici sur la sortie Debug.Print
$A$7:$K$138 11 132

06/08/2015, 12h16
patricktoulon

re
bonjour vinc _bilb

il n'est pas necessaire de redimer le tablo
Code:

1 2 dim tablo as variant tablo=range(xy:x2y2)
il est automatiquement dimentionné

parcontre retenir le column.count de la plage pour le resize de la plage de reception Oui!
Code:

1 2 3 dim tablo,colcount tablo=range(xy:x2y2) colcount=range(xy:x2y2).columns.count
destination

Code:

cells(x,y).resize(ubound(tablo,colcount))=tablo
07/08/2015, 16h42
vinc_bilb

Merci Patrick :)