VBA

Résolu/Fermé
ouistit64 Messages postés 22 Date d'inscription dimanche 23 septembre 2007 Statut Membre Dernière intervention 24 juin 2009 - 7 juin 2008 à 15:04
ouistit64 Messages postés 22 Date d'inscription dimanche 23 septembre 2007 Statut Membre Dernière intervention 24 juin 2009 - 8 juin 2008 à 23:21
Bonjour,

J'ai un problème. Avec la macro ci-dessous j'arrive à recopier le tableau de plusieurs onglets sur un seul onglet les un au dessous des autres. Mon problème est qu'il me recopie la moitié du tableau ou parfois le tableau entier ça dépend des onglets. Ma plage de cellule au niveau des colonnes n'es pas variable (colonne A à AB), en revanche au niveau des lignes ça peut varier sachant que parfois les premières cellules peuvent être vide.

Pouvez vous m'aider ? Merci d'avance.

La macro :

Sub Test3()
Dim CL1 As Workbook, CL2 As Workbook
Dim FL1 As Worksheet, FL2 As Worksheet
Dim Fich As Variant, i As Byte, Rep$

'Répertoire des fichiers à copier
Rep = "u:\Outillage\outillage\"
Set CL1 = ThisWorkbook

'Ajoute une feuille au classeur destiné à recevoir les données des autres classeurs
CL1.Sheets.Add
CL1.ActiveSheet.Name = "FeuilCumul"

Set FL1 = CL1.ActiveSheet 'Instance le la feuille

'Crée le tableau des fichiers du répertoire
Set Fich = Application.FileSearch

'Ouverture des fichiers du répertoire
With Fich
.LookIn = Rep
.FileType = msoFileTypeExcelWorkbooks
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
Set CL2 = Workbooks.Open(.FoundFiles(i))
DoEvents

'Parcours des feuilles de chaque classeur
For Each FL2 In CL2.Worksheets

'Dernière ligne où coller les données copiées dans FL2
NoLigne = FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1

'Copie de la plage renseignée de chaque feuille du classeur
FL2.Range(FL2.Cells(1, 1), _
FL2.Cells(FL2.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row, _
FL2.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row)).Copy _
FL1.Range("A" & NoLigne)
DoEvents
Set FL2 = Nothing
Next
CL2.Close False 'fermeture du classeur copié
DoEvents
Set CL2 = Nothing
Next i
Else
MsgBox "Aucun fichier dans le répertoire " & Rep
End If
End With
End Sub

4 réponses

lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
7 juin 2008 à 18:05
Bonjour,
Il y a peut-être des ligne qui n'ont pas de donnée en A mais bien en d'autre colonne ?
Si oui, remplace la ligne..
    NoLigne = FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1 


par..
                    'Dernière ligne où coller les données copiées dans FL2
                    a$ = FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Address
                    NoLigne = FL1.Range(a$).Row + 1

même chose dans la sélection du bloc de copie, tu prend la dernière ligne de la colonne 1, mais si le bloc réel n'a pas de donnée dans la colonne 1, ne va pas plus loin.. Sais pas si j'ai été assé clair.

A+
0
ouistit64 Messages postés 22 Date d'inscription dimanche 23 septembre 2007 Statut Membre Dernière intervention 24 juin 2009
8 juin 2008 à 10:55
ça marche toujours pas il ne me prends toujours pas les dernières colonnes. Est il possible de lui indiquer de prendre les colonnes de A à AB et de commencer à la ligne 3 ? je pense que cela résoudrait mon problème non ?

Merci
0
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
8 juin 2008 à 13:15
Commencé à la ligne 3 ??? La copie ou le collage ?
Mais je crois que ca tu va pouvoir adapter, essaye cette macro, je l'ai tester et en principe c'est OK
Remplacer..
    'Copie de la plage renseignée de chaque feuille du classeur 
    FL2.Range(FL2.Cells(1, 1), _ 
    FL2.Cells(FL2.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row, _ 
    FL2.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row)).Copy _ 
    FL1.Range("A" & NoLigne) 

par..

    a$ = FL2.Range("A1").SpecialCells(xlCellTypeLastCell).Address
    b$ = "A" & FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row
    Noligne = FL1.Range(a$).Row
    NoColonne = FL1.Range(a$).Column
    FL2.Range(Cells(1, 1).Address, Cells(Noligne, NoColonne).Address).Copy _
    Destination:=FL1.Range(b$)

Tu dit...
A+
0
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
8 juin 2008 à 18:36
j'ai fait une petite erreur sur la ligne
       b$ = "A" & FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row

Remplacer ou ajouter par
    b$ = "A" & FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1
0
ouistit64 Messages postés 22 Date d'inscription dimanche 23 septembre 2007 Statut Membre Dernière intervention 24 juin 2009
8 juin 2008 à 23:21
t'es un chef merci beaucoup
0