Merger des fichiers

[sonskriverez]

Bonjour le Forum,

J'ai plusieurs fichiers à rassembler en un seul.
Il y a toujours 2 colonnes, je voudrais avoir qu'un seul contenant toutes les données des autres fichiers sur 2 colonnes.

Est-ce possible ?

Merci de votre aide

 

[sonskriverez]

Re : Merger des fichiers

Pardon j'ai oublié d'attacher les fichiers

 

[MJ13]

Re : Merger des fichiers

Bonjour,

Tu peux essayer de tester avec le fichier que j'ai mis dans ce post à la fin
https://www.excel-downloads.com/threads/pb-dimportation-dobjets-dans-une-macro.83569/

en remplaçant txt par xls et TXT par XLS
et en remplaçant
Workbooks.OpenText Filename:= _
chemin & "\" & f1.Name, Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Semicolon:=True

par

Workbooks.Open Filename:= f1.name.

 

[sonskriverez]

Re : Merger des fichiers

Bonjour MJ13,

Tout d'abord merci pour ton aide.

J'ai modifié ta macro selon tes instructions, mais cela plante, ii y une message d'erreur comme quoi il ne trouve pas classeur1.xls dans le repertoire.

la macro plante sur la ligne

Workbooks.Open Filename:=f1.Name

 

[MJ13]

Re : Merger des fichiers

Bonjour,

Testes ce fichier:

 

[vclerico]

Re : Merger des fichiers

Bonjour,
Je viens de tester le fichier "recupfichierXLS", mais la macro ne me récuppère que la première ligne de chaque fichier... Quelqu'un pourrait-il me porter secours?
Merci par avance.

 

[MJ13]

Re : Merger des fichiers

Bonjour

Essaie de modifer ces lignes:

Workbooks.Open Filename:=chemin & "\" & nomxls
Cells(1, 1).Select
ActiveCell.SpecialCells(xlLastCell).Select
'inclu_nom_fichier début
'derligne = ActiveSheet.Range("a65536").End(xlUp).Row
derligne = ActiveCell.Rows.Row

 

[StephGuerain]

Re : Merger des fichiers

Bonjour MJ13,

J'ai bien eu ton fichier car j'étais dans le besoin également, donc il est super cela me convient à l'exeption de 2 ou 3 petites choses, en fait dans ton fichier on limite le nombre de ligne, j'aimearis que cela soit variable suivant si j'ai dans un fichier 100 ou dans un autre fichier 300 lignes et que cela se copie les uns en dessous des autres.

Peux-tu m'aider stp

Merci

Stéphane

 

[MJ13]

Re : Merger des fichiers

Bonjour Stéphane

Teste ce fichier:

 

[StephGuerain]

Re : Merger des fichiers

Bonjour,

Meilleurs voeux à tous dans un premier temps.

J''execute actuellement la macro de MJ13 qui fonctione très bien, mais j'ai une complication, les fichier que j'ouvre maintenant sont bourré de formule, et d'une macro.

Comment faire pour modifier le programme en lui demandant d'exécuter les macros à l'ouverture des fichiers et avant de copier de selectionner un onglet appelé "ongle de saisi" .

J'espère avoir été addez clair sinon dites le moi.

Cdlt

Steph

PS: je me met petit à petit à vba j'ai acheté la collection de CD du site Polykromy mais il faut du temps

 

[MJ13]

Re : Merger des fichiers

Bonjour

voir:

[COLOR=black][FONT=Verdana]Application.Run "Classeur1!Macro1"[/FONT][/COLOR]

et

Sheets("ongle de saisi").select

 

[StephGuerain]

Re : Merger des fichiers

Bonsoir MJ13,

Merci pour cette aide, j'ai juste eu à utiliser le 2ème code, et cela fonctionne nickel.

Par contre maintenant je voudrais coller les données uniquement en valeur, comment je peux ajouter la ligne de commande, car je ne vois pas la ligne de commande qui dit de coller.

D'avance merci de ton aire

Stéphane

 

[StephGuerain]

Re : Merger des fichiers

Bonjour Personne pour m'aider sniffff

 

[jeanpierre]

Re : Merger des fichiers

Bonjour StephGuerain, Michel, le fil,

Peut-être en utilisant l'enregistreur de macro qui va te donner un truc du genre :

Sub Macro1()
Range("ta selection par exemple").Select 'ou ta feuille....
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub

Bon après-midi.

Jean-Pierre

Edit : remplacer le Sub Macro1() par :

Private Sub Workbook_beforesave(ByVal SaveAsUI As Boolean, cancel As Boolean)
à mettre dans le ThisWorkbook et non dans un module.

 

[StephGuerain]

Re : Merger des fichiers

Bonjour Jean-Pierre,

Merci pour ton aide mais en fait je ne trouve pas dans la macro le moment ou il colle les données

Public chemin As String
Public ceclasseur As String
Public nomxls As String
Public ii As Single
Public derligne As Single
Sub ImportXLSFile()
'code de Coriolan modif par MJ issu de https://www.excel-downloads.com/threads/pb-dimportation-dobjets-dans-une-macro.83569/
'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("ONGLET DE SAISI").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(14 & ":" & 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

Peux-tu me dire à quel moment je dois mettre le collage special valeur afin qu'il le fasse à chaque fichier qu'il copie

D'avance merci

Stéphane