Macro che colletta dei file in varie cartelle

[tav]

Ciao a tutti

io ho dei file excel in varie cartelle con percorsi diversi. Tutti i file si chiamano nello stesso modo cioè SIM e la data del giorno in corso ( esempio SIM 23-04-18).

questi file devono essere collettati in un unico file che deve essere salvato in una nuova cartella e salvato semplicemente con il nome SIM.

ogni file deve essere copiato fino a che non trova la riga bianca, quando la trova deve iniziare a copiare dalla riga A6 del file successivo.

allego due dei file come esempio
https://we.tl/qlqRc9Twl3

[Anthony47]

Beh, non puoi sempre passarci le specifiche funzionali e aspettare il risultato...

Allora diciamo che il tuo primo problema e' raccogliere l'elenco dei file da processare.
Per questo potresti usare la Function RecurDir creata per altro utente qui: http://pop.pc-facile.com/forum/viewtopi ... 62#p632405

Richiamerai questa RecurDir con lo stesso metodo descritto al link suddetto:

Codice: Seleziona tutto

Dim FArr() As String
ReDim FArr(1 To 1)
allpics = Array("xlsx")    '<<< Altri formati?       'Adattato al tuo caso
StrDir=" C:\PERCORSO\Documents"         '<<< Il Percorso iniziale
Call RecurDir(StrDir, allpics, FArr)


In questo modo avrai nella matrice Farr un elenco di file xlsx presenti nella directory StrDir e tutte le sue subdirectory.

In un ciclo successivo potrai scansionare il contenuto di Farr e determinare se il nome file comincia con "SIM ".
Anzi, pensandoci puoi mettere questo controllo direttamente nel codice della RecurDir in questo modo:

Codice: Seleziona tutto

ccAll = ccAll + 1
    mysplit = Split(" " & myItm, ".", , vbTextCompare)
    If Not IsError(Application.Match(mysplit(UBound(mysplit)), myExt, 0)) Then
        If InStr(1, mysplit(UBound(mysplit)), "SIM ", vbTextCompare) > 0 Then       '++++
            myind = UBound(cStore)
            ReDim Preserve cStore(1 To myind + 1)
            cStore(myind) = myItm
        End If                                                                      '++++
    End If
Mahh:


Rispetto al codice originale e' stato aggiunto il blocco If /End If marcato ++++

In questo modo avrai nella matrice Farr direttamente il nome dei file presenti nel filesystem a partire dal percorso che hai indicato e che si chiamino SIM *.xlsx

Ora sei pronto per aprire uno dopo l'altro i vari file, selezioni il foglio che serve, copi l'area che serve e la incolli nel file che stai creando nella posizione giusta.

Prova... e se ti areni fai sapere dove sei arrivato e su quale argomento hai invece frenato.

Ciao

[tav]

Ciao Anthony,

ho provato a mettere a posto la macro, ma quando la lancio il sistema si "impalla".continua a caricare fino a quando excel non si blocca

Codice: Seleziona tutto

Dim myFso As Object, ccAll As Long
Function RecurDir(ByVal ccDir As String, myExt As Variant, ByRef cStore As Variant) As String
Dim myItm
'
If myFso Is Nothing Then Set myFso = CreateObject("Scripting.FileSystemObject")
If myFso Is Nothing Then Beep
DoEvents
On Error GoTo Mahh
For Each myItm In myFso.GetFolder(ccDir).Files
ccAll = ccAll + 1
    mysplit = Split(" " & myItm, ".", , vbTextCompare)
    If Not IsError(Application.Match(mysplit(UBound(mysplit)), myExt, 0)) Then
        If InStr(1, mysplit(UBound(mysplit)), "SIM & "" & Format(now,dd-mm-yyyy)", vbTextCompare) > 0 Then       '++++
            myind = UBound(cStore)
            ReDim Preserve cStore(1 To myind + 1)
            cStore(myind) = myItm
        End If                                                                      '++++
    End If
Mahh:
Resume Bohh
Bohh:
Next myItm
For Each myItm In myFso.GetFolder(ccDir).SubFolders
    Call RecurDir(myItm, myExt, cStore)
Next myItm
End Function

Sub Pulsante1_Click()
Dim FArr() As String
ReDim FArr(1 To 1)
allpics = Array("xlsm")    '<<< Altri formati?       '***
StrDir = " \\193.43.114.144\shares\Divisione Buitoni\Supply Chain\Demand&Supply Planning\Business Position & Supply Issues Monitor BUITONI\SUPPLY ISSUES MONITOR\prova Andrea\storico ambi SIM"       '<<< Il Percorso iniziale
Call RecurDir(StrDir, allpics, FArr)
End Sub


[Anthony47]

io ho dei file excel in varie cartelle con percorsi diversi

Quella macro parte dalla directory che gli dici e cerca in tutte le directory sottostanti; quindi quanto tempo richiedera' non lo so, dipende da quanto e' largo e lungo il filesystem sottostante.
Se invece tu sapessi gia' in quale directory cercare le cose sarebbero piu' semplici...

[tav]

Deve cercare in quel percorso e le cartelle sono 5 dentro le quali c sono vari file Excel e deve prendere solo quello con il nome sim più la data del giorno odierno

[Anthony47]

Se la ricerca e' da fare in poche posizioni note allora diventa molto piu' semplice.
Ad esempio puoi memorizzare in una matrice i l'elenco dei file che rispettano il filtro con questa function:

Codice: Seleziona tutto

Function MonoDirXlsm(ByVal ccDir As String, myFilt As String, ByRef cStore As Variant) As Long
Dim myInd, myF As String
'
If Right(ccDir, 1) <> Application.PathSeparator Then ccDir = ccDir & Application.PathSeparator
myF = Dir(ccDir & myFilt)
Do While myF <> ""
Debug.Print myF
    myInd = UBound(cStore)
    ReDim Preserve cStore(1 To myInd + 1)
    cStore(myInd) = ccDir & myF
    DoEvents
    myF = Dir
Loop
MonoDirXlsm = UBound(cStore) - 1
End Function


Poi devi richiamarla con qualcosa tipo

Codice: Seleziona tutto

Sub Pulsante1_Click()
Dim FArr() As String, StrDir As String, Filtr As String
Dim NumF As Long
'
ReDim FArr(1 To 1)
Filtr = "SIM*.xlsm"                        '<<< Il "filtro"
StrDir = "C:\IlPercorso1"                   '<<< Il Percorso iniziale1
NumF = MonoDirXlsm(StrDir, Filtr, FArr)
StrDir = "C:\IlPercorso2"                   '<<< Il Percorso iniziale2
NumF = MonoDirXlsm(StrDir, Filtr, FArr)
StrDir = "C:\IlPercorso3"                   '<<< Il Percorso iniziale3
NumF = MonoDirXlsm(StrDir, Filtr, FArr)
'Ripetere per gli altri percorsi
'
'Qui il codice per processare i file individuati
'
End Sub


In questo modo ti troverai nella variabile NumF il numero di file individuati e in Farr il percorso + nome dei file file da processare.
Poi processerai i file con un ciclo del tipo

Codice: Seleziona tutto

For I=1 to NumF
    mioFile=FArr(i)
    '
    'le istruzioni per processare il singolo nome file
    'le istruzioni per processare il singolo nome file
    '
Next I


Ciao