Importing data from an .SRT-FIle into Excel

Question

I built an Excel template which converts .SRT files into a script format.

The structure of an .Srt file:

NUMBER OF SUBTITLE

TIMECODE IN --> TIMECODE OUT

LINE OF TEXT

(.SRT-File-Structure)

1

00:00:01,369 --> 00:00:04,500

Hello there

2

00:00:05,102 --> 00:00:10,200

I am Manuel

(... and so on)

I tried this:

Sub Datei_auswaehlen()
 
Dim Dateiname As Variant
Dim wbQuelle As Workbook
Dim letzteZeile As Long
 
'ScreenUpdating und PopUps deaktivieren
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dateiname = Application.GetOpenFilename(FileFilter:="Excel-Dateien (*.srt*),*.srt*")

If Dateiname <> False Then
 
    letzteZeile = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
   
    Set wbQuelle = Workbooks.Open(Filename:=Dateiname)
    
    wbQuelle.Worksheets(1).Range("A:A").Copy
    ThisWorkbook.Worksheets(1).Range("A:A").PasteSpecial
    
    wbQuelle.Close SaveChanges:=False
     
End If
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
End Sub

I want to copy everything into Excel in column A.

Some .srt files are cut in half like this:

1

00:00:41

Text in Line 1


2

00:00:45

Text in Line 2

Answer 1

Please, test the next updated code. It will open the file using OpenText and will paste its first pate, first column content in the active sheet of the workbook keeping the code (so, it must have its first column empty, otherwise, the code will overwrite its content):

Sub Datei_auswaehlen()
 Dim Dateiname As String, wbQuelle As Workbook, letzteZeile As Long, shC As Worksheet
 
 'ScreenUpdating und PopUps deaktivieren
 Application.ScreenUpdating = False
 
 Set shC = ActiveSheet  'use here the sheet to copy in

 Dateiname = Application.GetOpenFilename(FileFilter:="Excel-Dateien (*.srt*),*.srt*")

 If Dateiname <> "" Then

    Workbooks.OpenText fileName:=Dateiname, origin:=65001, _
            startRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, Tab:=True _
           , space:=False, Other:=False, FieldInfo:=Array(1, 2)
           
     Set wbQuelle = ActiveWorkbook
     letzteZeile = wbQuelle.Worksheets(1).cells(rows.count, 1).End(xlUp).row
     
     With wbQuelle.Worksheets(1).Range("A1:A" & letzteZeile)
          shC.Range("A1").Resize(.rows.count, .Columns.count).Value = .Value
    End With
    shC.Range("A:A").EntireColumn.AutoFit
    
    wbQuelle.Close SaveChanges:=False
     
 End If

Application.ScreenUpdating = True
End Sub

Please, send some feedback after testing it. If something not clear enough, do not hesitate to ask for clarifications.