Option Explicit

Sub Aggiorna_assortimento()

Dim Ws1 As Workbook: Set Ws1 = Workbooks("pulizia db_Prova.xlsm")
Dim Sh1 As Worksheet: Set Sh1 = Ws1.Worksheets("db1")
Dim Ws As Worksheet, Area As Range, RR As Object
Dim Uriga1 As Long, Uriga2 As Long, r As Long, X As Long
Dim ID As String, Percorso As String, nomeFile As String

Dim Conta As Integer
Dim RigaMax As Integer, ColMax As Integer
Dim A As Integer, B As Integer
Dim Tempo As Single


Application.ScreenUpdating = False
Application.EnableEvents = False


Conta = 0
RigaMax = Uriga2
ColMax = 9


For A = 1 To RigaMax
For B = 1 To ColMax

On Error Resume Next

Uriga1 = Sh1.Range("A" & Rows.Count).End(xlUp).Row
Set Area = Sh1.Range("A3:A" & Uriga1)
Percorso = "C:Users
icola.spanuDesktopdbnew2.Xlsx"
Workbooks.Open (Percorso)
For Each Ws In ActiveWorkbook.Worksheets

Ws.Activate

Uriga2 = Ws.Range("A" & Rows.Count).End(xlUp).Row

For X = 2 To Uriga2

ID = Cells(X, 1).Value

Set RR = Area.Find(ID, LookIn:=xlValues, Lookat:=xlWhole)

If r <> ID Then

r = 0

r = RR.Row

Ws.Cells(X, 28) = Sh1.Cells(r, 9)


End If

Next X


Tempo = Conta / (RigaMax * ColMax)

UpdateProgressBar Tempo

Next Ws
  
Unload UserForm1

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=True
Application.DisplayAlerts = True

MsgBox "Aggiornamento eseguito con successo"

Set Sh1 = Nothing

Set Ws1 = Nothing
Set Area = Nothing
End Sub

Sub ShowUserForm()
UserForm1.Show
End Sub


Sub UpdateProgressBar(Tempo As Single)
 
 With UserForm1

            .FrameProgress.Caption = Format(Tempo, "0%")

       
         .LabelProgress.Width = Tempo * _
             (.FrameProgress.Width - 10)
     End With

    
     DoEvents
 End Sub

Private Sub UserForm_Activate()
UserForm1.LabelProgress.Width = 0
Call Aggiorna_assortimento
End Sub

Option Explicit

Sub Aggiorna_assortimento()


Dim Ws1 As Workbook: Set Ws1 = Workbooks("pulizia db.xlsm")
Dim Sh1 As Worksheet: Set Sh1 = Ws1.Worksheets("db1")
Dim Ws As Worksheet, Area As Range, RR As Object
Dim Uriga1 As Long, Uriga2 As Long, R As Long, X As Long
Dim ID As String, Percorso As String, nomeFile As String

Application.ScreenUpdating = False
Application.EnableEvents = False

On Error Resume Next

Uriga1 = Sh1.Range("A" & Rows.Count).End(xlUp).Row
Set Area = Sh1.Range("A3:A" & Uriga1)
Percorso = "C:Users
icola.spanuDesktopdbnew2.Xlsx"
Workbooks.Open (Percorso)
For Each Ws In ActiveWorkbook.Worksheets

Ws.Activate

Uriga2 = Ws.Range("A" & Rows.Count).End(xlUp).Row

For X = 2 To Uriga2

ID = Cells(X, 1).Value

Set RR = Area.Find(ID, LookIn:=xlValues, Lookat:=xlWhole)

If R <> ID Then

R = 0

R = RR.Row

Ws.Cells(X, 28) = Sh1.Cells(R, 9)



End If

Next X

Next Ws
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=True
Application.DisplayAlerts = True

MsgBox "Aggiornamento eseguito con successo"

Set Sh1 = Nothing

Set Ws1 = Nothing
Set Area = Nothing
End Sub

    For X = 2 To Uriga2
        ID = Cells(X, 1).Value
        Set RR = Area.Find(ID, LookIn:=xlValues, Lookat:=xlWhole)
        If Not RR Is Nothing Then
            If R <> ID Then
                R = 0
                R = RR.Row
                Ws.Cells(X, 28) = Sh1.Cells(R, 9)
            End If
            TEMPO = (X) / Uriga2
            UpdateProgressBar TEMPO
        End If
    Next X