VBA: ripetere , in automatico, la stessa macro su tutti i files xlsm di una cartella

[pic omnic]

Buongiono. In una unica cartella ho 30-40 files xlsm. Sono tutti uguali tra loro (cambiano i dati naturalmente). Dovrei modificare alcuni di questi dati utilizzando una procedura VBA (come riporto sotto). Potrei inserire la macro in un modulo del primo file, lanciarla, salvare il file, cancellare la macro e ripetere il tutto manualmente su tutti i file presenti nella cartella. Ma sarebbe assai noioso e lungo. Come fare per automatizzare la procedura ? La macro interessata dovrebbe essere posta naturalmente in un file a parte.
Grazie mille
Draleo
Questa è la mia procedura
Public Sub conclusione()
Dim nr As Long
Dim l As Long
Dim rng As Range
With Worksheets("DataBase")
nr = .Range("A65536").End(xlUp).Row
For l = nr To 4 Step -1
If .Cells(l, 9) = "" Then
.Cells(l, 9) = .Cells(l - 1, 9)
End If
Next l
Set rng = .Range("B4:" & "B" & nr)
rng.Replace What:="NZ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Range("X4") = "Pippo"
.Range("Y4") = "Pluto"
.Range("Y4") = "Paperino"

End With
End Sub

[Norman Jones]

Ciao Draleo,

In un modulo di codice standard di una cartella di lavoro diverso dai file di interesse, prova qualcosa del genere:
'========>>
Option Explicit

'-------->>
Public Sub Conclusione()
Dim destWB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim arrFile() As Variant
Dim sPath As String, sStr As String
Dim sFileName As String, sMsg As String
Dim nr As Long
Dim l As Long, iCtr As Long

Const sPercorso As String = "C:\Users\Draleo\Mia Cartella" '<<=== Modifica
Const SFoglio As String = "Database"

sStr = Application.PathSeparator
If Right(sPercorso, 1) = sStr Then
sPath = sPercorso
Else
sPath = sPercorso & sStr
End If

On Error GoTo ErrHandler
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
sFileName = Dir(sPath & "*.xlsm")
Do Until sFileName = ""
If sFileName <> ThisWorkbook.Name Then
Set destWB = Workbooks.Open(sPath & sFileName)
Set SH = destWB.Sheets(SFoglio)
With SH

nr = .Range("A65536").End(xlUp).Row
For l = nr To 4 Step -1

If .Cells(l, 9).Value = "" Then
.Cells(l, 9).Value = .Cells(l - 1, 9).Value
End If
Next l
Set Rng = .Range("B4:" & "B" & nr)
Rng.Replace What:="NZ", Replacement:="", LookAt:=xlPart, _

SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

.Range("X4").Value = "Pippo"

.Range("Y4") = "Pluto"

.Range("Z4").Value = "Paperino"
End With

iCtr = iCtr + 1
ReDim Preserve arrFile(1 To iCtr)
arrFile(iCtr) = destWB.Name
destWB.Close SaveChanges:=True
End If
sFileName = Dir()
Loop

If CBool(iCtr) Then
sMsg = Join(arrFile, vbNewLine)
Call MsgBox(Prompt:="File aggiornati:" & vbNewLine & sMsg, _
Buttons:=vbInformation, _
Title:="REPORT")
End If
XIT:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
On Error GoTo 0
Exit Sub

ErrHandler:
Call MsgBox(Prompt:="Errore " & Err.Number & " (" & Err.Description & ") nella procedura Conclusione", _
Buttons:=vbCritical, _
Title:="ERRORE")
Resume XIT
End Sub
'<<========


--
Regards,
Norman

[pic omnic]

Fantastico ! in 3 minuti esegue -benissimo- un lavoro che a mano avrebbe richiesto 3 ore di tempo !
grazie mille
draleo

[Norman Jones]

Ciao Draleo,

On Tuesday, June 15, 2021 at 5:06:35 PM UTC+1, dra...@libero.it wrote:

> Fantastico ! in 3 minuti esegue -benissimo- un lavoro che a mano avrebbe richiesto 3 ore di tempo !
> grazie mille
> draleo

Prego!

Alla prossima.


--
Regards,
Norman

[pic omnic]

Avrei la necessità di aggiungere un pezzo di codice, a quello già esistente e perfettamente funzionante; ma tutti i miei tentativi sono andati a vuoto. Riassumo: ci sono tanti files xlsm nella cartella. In ogni file della cartella scelta, nella colonna K, dovrei mettere dei valori calcolati (da K4 in giù).
La formula utilizzata è abbastanza semplice e fa riferimento al numero della rigainteressata e al contenuto della cella H1, denominata numprimapag
cioè
ognicelladellacol K= numerorigainteressata + numprimapag
La difficoltà (per me) è dovuta al fatto che mentre nel primo file, nella cella H1, c’è sempre un valore introdotto da me, nei files successivi nella cella H1 deve andarci, in automatico, il valore dell’ultima riga della col K calcolata nel file precedente. Come si fa ?
draleo

[Norman Jones]

Ciao Draleo,

Qual è la formula esatta che deve essere inserita nelle celle K4 in basso di ogni file ?
Dato che il valore nella cella H1 di ogni file è sequenziale, come stabilire l'ordine dei file ?


--
Regards,
Norman

[pic omnic]

-I files sono denominati prova(1),prova(2),prova(3) ecc. quindi vengono sequenziati in automatico .Potrebbero esserci problemi con prova(10),prova(11) ecc, ma farò in modo che nella cartella non si vada oltre il prova(9)
-la formula che deve andare nelle celle della col K (da K4 in giù) è
.Range("K" & numriga) = Int((numriga - 3) / numimmpag) + numprimapag
dove
numprimapag = .Range("H1")
numimmpag = .Range("L1")
Mentre Nel primo file della sequenza ,io introduco manualmente il numprimapag in H1, negli altri files H1 dovrebbere essere posto automaticamente (e deve essere uguale al valore dell'ultima cella K del file precedente)
grazie
draleo