Sub getinfo_Film1234()
Dim fd As FileDialog
Dim wb As Workbook, sh As Worksheet, kq()
Dim lastRow As Long, lastCol As Long, count As Long, k As Long, r As Long, n As Long
'Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Select Log Film"
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "excel file", "*.xlsx"
.InitialFileName = ""
If .Show <> -1 Then Exit Sub
End With
ReDim kq(1 To 1000000, 1 To 1)
For k = 1 To fd.SelectedItems.count
count = 0
Set wb = Workbooks.Open(fd.SelectedItems(k))
If wb.Worksheets.count = 1 Then
Set sh = wb.Worksheets.Add
sh.Name = "Sheet2"
Else
Set sh = wb.Worksheets("Sheet2")
End If
With wb.Worksheets("Sheet1")
lastRow = .Cells(Rows.count, "A").End(xlUp).Row
.Range("A1").Resize(lastRow).TextToColumns DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
Other:=True, OtherChar:=";", TrailingMinusNumbers:=True
For r = 1 To lastRow
If .Range("A" & r).Value <> "" Then
lastCol = .Cells(r, Columns.count).End(xlToLeft).Column
For n = 1 To lastCol
kq(count + n, 1) = .Cells(r, n).Value
Next n
count = count + lastCol
End If
Next r
sh.Range("A1").Resize(count).Value = kq
wb.Close True
End With
Next k
' Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
MsgBox "Done"
End Sub
