Essendo sicuro che la macro di Ricky funzioni a dovere
ho semplicemente modificato il percorso da "Statico" a "Automatico"
In pratica il file destinazione (con macro) deve stare nella stessa cartella dei file con dati
La macro rileverà tale percorso e processerà tutti i file contenuti nella cartella e aventi estensione .xls escludendo il file destinazione.
- Codice: Seleziona tutto
Option Explicit
Public RR As Long, J As Long, Inizio As Double
Public MioPercorso As String, MioFile As String
Public Ws_In As Worksheet, Ws_Out As Worksheet
Sub Leggi_Dati_e_Copia_Celle()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Sheets("Sintesi").Select
Set Ws_Out = Sheets("Sintesi")
MioPercorso = ThisWorkbook.Path '<<<< aggiunto percorso del file destinazione
MioFileM = ThisWorkbook.Name '<<<< Ricava il nome del file destinazione
MioFile = Dir(MioPercorso & "*.xls*")
J = Ws_Out.Range("F" & Rows.Count).End(xlUp).Row + 1
RR = J
Do While MioFile <> ""
If MioFile <> MioFileM Then
Workbooks.Open Filename:=MioPercorso & MioFile
Set Ws_In = Sheets("SetUpthePlan")
Ws_In.Range("B3:L3").Copy
Ws_Out.Range("F" & J).PasteSpecial xlPasteValues
Ws_Out.Range("Q" & J) = Date
Windows(MioFile).Close savechanges:=False
J = J + 1
Application.CutCopyMode = False
MioFile = Dir()
End If
Loop
Set Ws_In = Nothing
Set Ws_Out = Nothing
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Prova e fai sapere
ciao