Pb d'adaptation d'un script pour intégrer des données de plusieurs classeurs en un

[jecirbe]

Bonsoir à tous,
Après maintes recherche sur ce forum, sur d'autre, sur google, je lance un appel à l'aide.
Je suis sous excel 7 et pour tout avouer j'apprends sur le tas le VBA.
J'ai adapter à mes besoins un script de facturation qui incrémente le numéro et me donne des factures rassemblées par date du jour. Pour être plus clair les factures sont enregistrées sous la forme suivante : "Factures-YYYYMMDD-N°facture".
Chaque classeur "Factures" à 2 feuilles:
- 1 onglet "YYYYMMDD-N°facture" qui est ensuite imprimer
- 1 onglet récap (du jour): constitué d'un tableau avec 6 colonnes dont les entêtes sont: Date facture Numéro Montant Nom Prénom Adresse

Ce que je cherche à faire c'est un récapitulatif global, c'est à dire copier les données de la feuille "récap" et copier tout dans un seul classeur. Pour le moment j'ai 100 fichiers, donc il est évident que je souhaite automatiser à l'aide d'une boucle.
J'ai trouver un script qui ne déclenche aucun message d'erreur . Le hic, est que ça à l'air de tourner dans le vide ou du moins la copie semble se dérouler mais pas le collage.
Voici le code, qui n'est pas de moi j'avoue:

Sub ouvrir_et_fermer_fichiers()
Dim ScanFic As Office.FileSearch
Dim NomFic As Variant
Dim Diag As String, fich As String, exten As String
Dim Nbr As Long
Dim NBlignes As Integer, NBCol As Integer
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim Chemin As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
Chemin = oFolderItem.Path
Range("A1").Value = Chemin '-----> à adapter si vous avez quelque chose en A1
exten = InputBox("Saisissez ici l'extension souhaitée pour la recherche. Par ex : xls pour excel, doc pour word, ppt pour powerpoint, pour tous fichiers tapez *.*", "Extension de fichier")
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
.LookIn = Range("A1").Value
.SearchSubFolders = True
.Filename = exten
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
Nbr = .Execute
For Each NomFic In .FoundFiles
    Workbooks.Open Filename.Sheets("récap").Select
    Range(Cells(1, 1), Cells(DerniereLigne, 1)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    i = 1   
    While Not Range("A" & i & "").Value = ""
    i = i + 1
    Wend
    ActiveSheet.Paste
Next
End With
End Sub

Pouvez vous m'aider à corriger les erreurs en explicitant.
Soyez indulgent j'apprends vraiment sur le tas en me basant sur ce que j'ai déjà "bidouiller" sur l'adaptation de la facturation.

Merci d'avance pour vos réponses

 

[Grand Chaman Excel]

Re : Pb d'adaptation d'un script pour intégrer des données de plusieurs classeurs en

Salut jecirbe,

Je n'ai pas testé ton code mais le problème dois venir de ta fonction .copy et .paste. Personnellement, j'utilise la méthode

PlateACopier.Copy Destination:= PlageDestination

Je t'envoie un code avec cette façon de faire que je traîne avec moi depuis longtemps qui permet d'exécuter la même instruction sur plusieurs fichiers. Ça devrait fonctionner pour toi, il te restera à adapter un peu pour la plage à copier.

Option Explicit

Sub CompilationFichiers()

Dim wbDestination As Workbook, wbSource As Workbook
Dim wsSource As Worksheet, wsDestination As Worksheet
Dim vfiles As Variant
Dim NomFichier As String
Dim nindex As Integer
Dim rgRead As Range, rgtocopy As Range, rgtarget As Range
Dim wrow As Integer

Set wbDestination = ThisWorkbook
Set wsDestination = wbDestination.Sheets("Destination")             'feuille de destination********** à adapter

'Ouvrir boite de dialogue pour sélectionner les fichiers à traiter
vfiles = GetFiles("Sélectionner les fichiers à compiler") 'Appel de Fonction pour ouvrir fichiers

'Vérifier si au moins 1 fichier choisi
If Not IsArray(vfiles) Then
    MsgBox "Erreur! Aucun/Mauvais fichier sélectionné."
    Exit Sub
End If
On Error Resume Next

Application.ScreenUpdating = False

'======================
'Boucle à travers les fichiers choisis
'======================
For nindex = 1 To UBound(vfiles)
    Application.StatusBar = ">> Analyse en cours du fichier #" & nindex & "/" & UBound(vfiles)
    NomFichier = vfiles(nindex)
    
    ' //////////////////////////////////////
    ' C'est ici qu'on écrit les instructions
    
    'Créer variable de travail pour le fichier ouvert
    Set wbSource = Workbooks.Open(NomFichier)                   'ouvrir le fichier source
    Set wsSource = wbSource.Sheets("récap")                     'La feuille Récap*********** à adapter
    wrow = wsDestination.Range("A60000").End(xlUp).Row + 1      'ligne pour écrire les nouveaux résultats
    
    'Copier / Coller
    Set rgtocopy = wsSource.Range("A1:F10")             '*************à adapter !!!     Plage à copier
    Set rgtarget = Range(wsDestination.Cells(wrow, 1), wsDestination.Cells(wrow, 1))    'Plage destination
    
    rgtocopy.Copy Destination:=rgtarget
    
    'Fermer le fichier source ouvert
    wbSource.Close                                       'fermer fichier
    Set wbSource = Nothing
    ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    
Next nindex 'on passe au fichier suivant

Application.StatusBar = "Terminé !!!"
Application.StatusBar = False
Application.ScreenUpdating = True

End Sub

Function GetFiles(sTitle As String) As Variant
Dim sFilter As String
Dim bMultiSelect As Boolean
sFilter = "Fichiers (.xls)(.xlsm), *.xls*"      'changer les extensions ici
bMultiSelect = True                             'False pour choisir 1 fichier à la fois
GetFiles = Application.GetOpenFilename(Filefilter:=sFilter, Title:=sTitle, _
    MultiSelect:=bMultiSelect)
End Function

 

[jecirbe]

Re : Pb d'adaptation d'un script pour intégrer des données de plusieurs classeurs en

Merci pour cette réactivité.
je vais regardé ça et je vous tiens au courant de l'évolution.

Aller on y croit!!

 

[jecirbe]

Re : Pb d'adaptation d'un script pour intégrer des données de plusieurs classeurs en

il te restera à adapter un peu pour la plage à copier.

La plage à copier est variable. En effet si sur une journée je fais 5 factures dans la journée, ma feuille récap aura 5 lignes, si j'en fait 10, ben 10 lignes. Donc comment adapter cette partie de code?