Discussion :

[viguievt]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[fring]

Bonjour,

Essaie comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[viguievt]

Bonjour Fring,

Un grand merci, cela fonctionne parfaitement. Je n'ai plus que 2, 3 modifs à faire pour caler le fichier.

[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.