psycho185
Messages postés2Date d'inscriptionjeudi 9 juin 2011StatutMembreDernière intervention 9 juin 2011
-
9 juin 2011 à 15:24
Bonjour,
J'essaye de concaténer des feuilles excel dans un répertoire donné en une seul, les feuilles contiennent les même colonnes, j'ai fait une macro pour cela dont le code est le suivant
[code]
Sub RegrouperFeuille()
Dim rep As String
Dim wk As Workbook
Dim XlApp As New Excel.Application
Dim XlBook As Workbook
Dim XlSheet As Worksheet
Dim ExisteFichier As Boolean
Dim nomFic As String
'Variable pour permettre de gerer les entetes
Dim i As Integer
i = 1
'On Error GoTo Erreur_Fichier:
Set XlBook = XlApp.Workbooks.Add
Set XlSheet = XlBook.Worksheets(1)
' test de l'existence du fichier prestataire
nomFic = ThisWorkbook.path & "\FichierPrestataire.xls"
ExisteFichier = (Dir(nomFic) <> "")
If ExisteFichier = True Then
Kill nomFic
End If
Dim l As Long
'Initialisations
l = 5
rep = ThisWorkbook.path & "\Prestataires\"
s = Dir(rep)
Do
Set wk = CreateObject(rep & s)
wk.Activate
If i = 1 Then
Range("A3").Select
Else
Range("A7").Select
End If
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
XlBook.Activate
If i = 1 Then
l = XlSheet.Range("A65356").End(xlUp).Row
Else
l = XlSheet.Range("A65356").End(xlUp).Row + 1
End If
XlSheet.Range("A" & l).Select
XlSheet.Paste
wk.Activate
Application.CutCopyMode = False
wk.Close savechanges:=False
s = Dir
i = i + 1
Loop While s <> ""
XlBook.Save
XlApp.Quit
'Erreur_Fichier:
'MsgBox "Le Dossier Prestataire ne contient aucun fichier"
End Sub
/code
J'ai le bon résultat dans le fichier cible, le problème est que j'ai des cellules en couleurs qui apparaissent en fin du fichier créé et je ne vois pas trop d'ou sa viens, aussi quelque cellules dont le contour disparaît (en fin de fichier également) si quelqu'un à une idée.