Sub auto_open()

For Each cn In ThisWorkbook.Connections        'elimina connessioni
 cn.Delete
Next
 
Sheets("Foglio1").Visible = True
Sheets("Foglio3").Visible = True
Application.ScreenUpdating = False         'refresh schermo
                                                                           
Sheets(Array("Foglio1", "eCAV")).Select         'cancella fogli
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents

Sheets("foglio3").Select                    'azzera [importa] tabella modello
    Cells.Select
    Selection.Copy
    Sheets("eCAV").Select
    Cells.Select
    ActiveSheet.Paste

Dim fd As FileDialog                                    'seleziona cartella
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim CartellaSelezionata As Variant
With fd
If .Show = -1 Then
For Each CartellaSelezionata In .SelectedItems
miaCartella = CartellaSelezionata
Next
Else: Exit Sub
End If
End With
 
Sheets("foglio1").Select

Dim MyFile As String
MyFile = Dir(miaCartella & "*.dmo")

Do While MyFile <> ""
   With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & miaCartella & "" & MyFile, Destination:=Range("A1"))
        .Name = "SOM59054_NP2216552_BFA_REP1_1"
         .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
     MyFile = Dir
Loop

For i = 2 To 30         'imposta distanza tra report
 If Left(Cells(1, 1).Value, 10) = Left(Cells(1, i).Value, 10) Then
 dist = i - 1
 Exit For
End If
Next i

k = 0                           'valori misurati
For j = 0 To Cells(Columns.Count).End(xlToLeft).Column Step dist
Sheets("foglio1").Select
y = 1
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("eCAV")
     If IsNumeric(Cells(i, 2 + j)) And Cells(i, 2 + j) <> "" And Application.IsText(Cells(i - 1, 2 + j).Value) Then
     .Cells(25 + k, 5 + y) = Cells(i, 2 + j)
     y = y + 1
     End If
     End With
Next i
k = k + 1
Next j

Sheets("foglio1").Select
y = 1
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("eCAV")
     If IsNumeric(Cells(i, 2)) And Cells(i, 2) <> "" And Application.IsText(Cells(i - 1, 2).Value) Then
      .Cells(6, 5 + y) = Cells(i - 1, 2)            'nomi quote
      .Cells(7, 5 + y) = Cells(i, 3)                  'nominali
      .Cells(8, 5 + y) = Cells(i, 3) + Cells(i, 5)    'valori max toll
      .Cells(9, 5 + y) = Cells(i, 3) + Cells(i, 6)    'valori min toll
      y = y + 1
     End If
     End With
Next i

'stringa = Cells(1, 1)
's = Split(stringa, "")
'Sheets("eCAV").Cells(3, 1) = s(3)

Sheets("eCAV").Select
Dim a As String                    'autofit colonne                                     'autofit colonne di tutti i fogli
Dim b As Worksheet
a = ActiveSheet.Name
For Each b In ActiveWorkbook.Worksheets
On Error Resume Next
b.Activate
Cells.EntireColumn.AutoFit
Next b
  
Sheets("foglio1").Select
Cells.Select
Range("A76").Activate
Selection.ColumnWidth = 10

Sheets("Foglio1").Visible = True
Sheets("Foglio3").Visible = False
Application.ScreenUpdating = False         'refresh schermo

End Sub