Faire une compilation de données à l'aide d'un macro

sknd2010

XLDnaute Nouveau
Bonjour tout le monde,

Je suis nouveau dans ce site et je me suis inscrit parce que je rencontre un grand souci avec un dossier dont je suis en charge dans mon entreprise et j'espère que quelqu'un pourrait m'aider parce que je suis dans l'impasse là.
Voilà, je veux créer un macro qui me permettrait de d'aller chercher des informations dans plusieurs fichier excel et les compiler sur un même fichier.
Voici le code que j'ai :
Public chemin As String
Public ceclasseur As String
Public nomxls As String
Public ii As Single
Public derligne As Single
Sub ImportXLSFile()

'Dim ceclasseur As String
'Dim monrépertoire As String
'Dim ii As Integer
'monrépertoire = "nom du répertoire contenant les fichiers .txt à importer"

'Stop
choisirRepertoire
ceclasseur = ThisWorkbook.Name

Set fc = CreateObject("Scripting.FileSystemObject").GetFolder(chemin).Files
If fc.Count > 0 Then 'il y a des fichiers
ii = 0
For Each f1 In fc
If Right(f1.Name, 3) = "xls" Or Right(f1.Name, 3) = "XLS" Then 'c'est un fichier texte
'ii = ii + 1
nomxls = f1.Name
ii = ActiveSheet.Range("C65536").End(xlUp).Row

'Workbooks.OpenText Filename:= _
chemin & "\" & f1.Name, Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Semicolon:=True
'Workbooks.Open Filename:=f1.Name

Workbooks.Open Filename:=chemin & "\" & nomxls 'inclu_nom_fichier début
Sheets("TEST").Select
derligne = ActiveSheet.Range("C65536").End(xlUp).Row
Range("A1:A" & derligne).Select
Selection.Insert Shift:=xlToRight
Selection.FormulaR1C1 = f1.Name
'inclu_nom_fichier fin
derligne = ActiveSheet.Range("C65536").End(xlUp).Row

'Rows(1).Copy Workbooks(ceclasseur).Sheets(1).Range("A" & ii + 1)
Rows(17 & ":" & derligne).Copy Workbooks(ceclasseur).ActiveSheet.Range("A" & ii + 1) 'Attention "Rows (2 " permet de ne pas copier le titre des fichier
ActiveWorkbook.Close savechanges:=False

End If
Next
End If

'Columns("A:IV").Select
'Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub


Sub choisirRepertoire()
' dl
'Racine = Range(R).Value
activedir = "C:\"
'Stop
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire pour" & choix, &H1&, activedir)
On Error Resume Next
'MsgBox objFolder.Title
chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path
If objFolder.Title = "" Then chemin = ""
x = InStr(objFolder.Title, ":")
If x > 0 Then chemin = Mid(objFolder.Title, x - 1, 2) & ""
If Not Len(chemin) = 0 Then Range(R) = chemin

End Sub



Ce n'est pas moi qui l'avais écrit ce code mais un collègue qui l'avait récupéré dans ce forum. Mais le soucis c'est que sur ce code, les données à sélectionner commencaient à la ligne 14 et maintenant c'est à partir de la ligne 17. et avec ce code le macro copié aussi les formules présentent dans les cellules ca que je souhaite supprimé aussi.

Je compte vivement sur votre aide pour pouvoir enfin continuer.

Merci d'avance
 

tototiti2008

XLDnaute Barbatruc
Re : Faire une compilation de données à l'aide d'un macro

Bonjour sknd2010,

Bienvenue sur XLD

Rows(17 & ":" & derligne).Copy Workbooks(ceclasseur).ActiveSheet.Range("A" & ii + 1)

on dirait que ça copie bien depuis la ligne 17, déjà

ce code le macro copié aussi les formules présentent dans les cellules ca que je souhaite supprimé aussi

c'est à dire ne conserver que les valeurs ? Copier/Collage spécial - Valeurs ?
 
Dernière édition:

sknd2010

XLDnaute Nouveau
Re : Faire une compilation de données à l'aide d'un macro

Bonjour Tototiti2008,

Oui exactement. je veux qu'il ne copie que les valeurs.
Et concernant la ligne 17 c'est moi qui l'ai changé mais ca ne marché pas correctement
il commence toujours la copié avant la ligne 17.
 
C

Compte Supprimé 979

Guest
Re : Faire une compilation de données à l'aide d'un macro

Bonjour,

La première ligne est trouvée par
derligne = ActiveSheet.Range("C65536").End(xlUp).Row

Et oui, si dans la colonne "C" il n'y a aucune donnée à partir de la ligne 17
Excel fait sa copie de
Code:
Rows(17 & ":" & [B][COLOR=red]PremièreLigneOccupée[/COLOR][/B]).Copy

A+
 

tototiti2008

XLDnaute Barbatruc
Re : Faire une compilation de données à l'aide d'un macro

Re,
Bonjour Bruno,

Oui, tout à fait

essaye en remplaçant la ligne en question par ça :

Code:
if derligne>17 then
Rows(17 & ":" & derligne).Copy Workbooks(ceclasseur).ActiveSheet.Range("A" & ii + 1)
Workbooks(ceclasseur).ActiveSheet.Range("A" & ii + 1).entirerow.copy
Workbooks(ceclasseur).ActiveSheet.Range("A" & ii + 1).pastespecial paste:=xlPasteValues
end if
 

sknd2010

XLDnaute Nouveau
Re : Faire une compilation de données à l'aide d'un macro

Re,
Bonjour BrunoM45 et merci pour ton aide =)

J'ai essayé mais ca ne marche toujours pas =(
maintenant je ne me copie rien du tout , il modifie les fichiers qu'il doit copier :s

Comment puis-je faire pour te joindre un fichier excel teste afin de te permettre de mieux comprendre?
 

sknd2010

XLDnaute Nouveau
Re : Faire une compilation de données à l'aide d'un macro

Re bonjour,

Au fait ca marche c'était juste parce que je n'avais pas copié le bon fichier dans C:/
Cependant, le petit c'est qu'il copie toujours les formules et d g ds cellule avec l'erreur #VALEUR. et vu que les formule sont identiques dans tous les fichiers à copier, il y a toujours un message d'alerte qui me dit que la formule existe déjà et je dois confirme pour que ca continue (C'est pas du tout pratique quoi!).

je vous vivement de votre aide
 

tototiti2008

XLDnaute Barbatruc
Re : Faire une compilation de données à l'aide d'un macro

Re,

Peut-être comme ça alors :

Code:
if derligne>17 then
Rows(17 & ":" & derligne).Copy 
Workbooks(ceclasseur).ActiveSheet.Range("A" & ii + 1).pastespecial paste:=xlPasteValues
Workbooks(ceclasseur).ActiveSheet.Range("A" & ii + 1).pastespecial paste:=xlPasteFormats
end if
 

Discussions similaires

Statistiques des forums

Discussions
311 716
Messages
2 081 828
Membres
101 823
dernier inscrit
mohamed3s