Compiler des données

Version imprimable

Bonsoir,

Après avoir longuement recherché sur le site, je me lance.

En effet j'ai un problème que je n'arrive pas à résoudre.

J'ai un fichier "BRUT" avec une centaine de feuilles.

Depuis un fichier "RECAP" je souhaiterai importer grâce à une macro toutes les données des feuilles (du classeur "BRUT") dans une seule et unique feuille (du classeur "RECAP").
Je souhaiterai mettre les données à la suite les unes des autres, car les feuilles ont toute la même forme.

Aujourd'hui j'ai un début de code, je ne suis pas expert, donc si quelqu'un peut me donner un coup de main se serait terrible.
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 41 42 43 Private Sub efface() 'macro pour effacer le contenu avant d'importer les données du fichier "BRUT"' Range("A5:K60000").ClearContents End Sub Sub copier() Dim i As Integer Dim J As Integer Dim comp As Integer Dim compteur As Integer Application.ScreenUpdating = True Application.Workbooks.Open ("D:\Data\TRAVAIL\Calcul Optimisation\BRUT.xlsx") comp = 0 'compteur pour les lignes à copier. Mise à zéro' compteur = 0 'compteur pour les feuilles à copier. Mise à zéro' For i = 13 To 3000 'je souhaite copier à partir de la ligne 13' For J = 1 To 100 'copier la feuille 1 à 100' Sheets(J).Activate If Not IsEmpty(Cells(i, 6)) Then 'si cellule F non vide' Range(Cells(i, 1), Cells(i, 11)).Select 'on selectionne la ligne de la colonne A à K' Selection.Copy 'on copie la ligne' Sheets("Recap").Activate Cells(comp + 1, 1).Select ActiveSheet("Recap").Paste comp = comp + 1 'on incremente le compteur' compteur = compteur + 1 'on incremente le compteur' Application.ScreenUpdating = False End If Next J Next i End Sub
pour info j'utilise excel 2007. Le problème c'est que je n'arrive pas à copier les données à la suite dans mon fichier "RECAP".

D'avance merci.

Bonjour,

Essaie comme ceci :

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
Sub copier()
Dim i As Integer, j As Integer, derL As Long
Dim WbkSource As Workbook
 
Application.ScreenUpdating = False
 
Set WbkSource = Workbooks.Open("D:\Data\TRAVAIL\Calcul Optimisation\BRUT.xlsx")
derL = ThisWorkbook.Sheets("Recap").Cells(Rows.Count, 6).End(xlUp).Row + 1
 
With WbkSource
    For j = 1 To .Sheets.Count
        For i = 13 To .Sheets(j).Cells(Rows.Count, 6).End(xlUp).Row
            If .Sheets(j).Cells(i, 6) <> "" Then
                .Sheets(j).Rows(i).Copy ThisWorkbook.Sheets("Recap").Cells(derL, 1)
                derL = derL + 1
            End If
        Next i
    Next j
End With
 
WbkSource.Close
Application.ScreenUpdating = True
MsgBox "Copie terminée", vbInformation
 
End Sub

06/12/2012, 09h42
viguievt

Bonjour Fring,

Un grand merci, cela fonctionne parfaitement. Je n'ai plus que 2, 3 modifs à faire pour caler le fichier.
06/12/2012, 10h48
kiki29

Salut, par curiosité mais plus complexe, généraliste et rapide il y a aussi ceci. 1.5 s pour traiter 170 feuilles et + de 4000 lignes au final sur un PC vieux de 10 ans.