Sub dimenticaMe()
'
Const strG As String = "G8:G8,G10:G10,G12:G12,G14:G14,G16:G16,G21:G21,G23:G23,G25:G25,G30:G30,G32:G32,G80:G80,G81:G81,G82:G82,G83:G83,G84:G84,G85:G85,G86:G86,G87:G87"
' T  = Offset(,13)
'
Dim oDlg As FileDialog, V
Dim oWbData As Excel.Workbook
Dim oWsData As Excel.Worksheet, oSoleMio As Excel.Worksheet
Dim rngTo As Range
Dim arrCells() As String, x As Long

Dim bln As Boolean: bln = Application.ScreenUpdating

Application.ScreenUpdating = False
'On Error GoTo fail 'a causa della prova
   Set oSoleMio = ThisWorkbook.Sheets(1)
   With oSoleMio
      Set rngTo = .Cells(1, .Columns.Count).End(xlToLeft).EntireColumn
      If rngTo.Cells(1).Value <> "" Then Set rngTo = rngTo.Offset(, 1).EntireColumn
   End With
   
   arrCells = Split(strG, ",")
   
   Set oDlg = Application.FileDialog(msoFileDialogOpen)
   With oDlg
      .AllowMultiSelect = True
      .Filters.Clear
      .Filters.Add "Excel-Datei(en)", "*.xls?"
      .Show
      For Each V In .SelectedItems
         Set oWbData = Workbooks.Open(V)
         With oWbData
            rngTo.Cells(1).Value = oWbData.Name & "_G"
            rngTo.Offset(, 1).Cells(1).Value = "_T"
            For Each oWsData In oWbData.Sheets
               For x = LBound(arrCells) To UBound(arrCells)
                If oWsData.Range(arrCells(x)).Value <> "" Then
                     oWsData.Range(arrCells(x)).Copy rngTo.Cells(rngTo.Cells.Count).End(xlUp).Offset(1)
                     oWsData.Range(arrCells(x)).Offset(, 13).Copy rngTo.Cells(rngTo.Cells.Count).End(xlUp).Offset(, 1)
                End If
               Next x
               
            Next oWsData
            .Close False
            Set rngTo = rngTo.Offset(, 2)
           
         End With
      Next V
   End With
   oSoleMio.Columns.AutoFit
   
On Error GoTo 0
fail:
Application.ScreenUpdating = bln
End Sub