VBA Makro jede 2te Zeile

Hallo,

folgendes kleines Problem, ich habe ca. 17.325 txt Dateien und möchte diese in Excel einfügen. Nun habe ich den unten angegebenen Code von einem User hier übernommen und nur kleinigkeiten geändert. Jetzt brauche ich noch folgendes. Mein Ziehl ist es, das die Daten aus der txt Datei in eine neue Excel Mappe übernommen wird und dabei jede 2te Zeile beschrieben wird. Also 2 Zeilen werden gefüllt A1 bis S1 und B2 bis S2 dann müssen 2 Zeilen\Spalten lehr bleiben, anschließend A5 bis S5 und A6 bis S6 usw. Also führ jede Hilfe wäre ich sehr dankbar.

Sub Start()

Application.DisplayAlerts = False

Dim strMaster As String
Dim strPath As String
Dim strFile As String
Dim intA As Integer

strMaster = ActiveWorkbook.Name

'Bitte den Pfad verfolständigen bsp.: …\Messdaten#100030"
strPath = „X:\41-Qualitymanagement\inspection of incoming goods_Wareneingangskontrolle\WEK\Externe Vermessung von Bauteilen\Eumetron\Messdaten…“

Columns(„C:Q“).Select
Selection.ClearContents

For i = 1 To 540

On Error Resume Next

intA = i
strFile = Range(„A“ & i).Value

Call Kopieren(strPath, strFile, intA, strMaster)

Next i

Application.DisplayAlerts = True

End Sub

Function Kopieren(strPath As String, strFile As String, intA As Integer, strMaster As String)

Workbooks.Open Filename:=strPath & strFile
Range(„A11:AN11,A16:AN16“).Select
Selection.Copy
Windows(strMaster).Activate
Range(„D“ & intA).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

=False, Transpose:=False

Windows(strFile).Activate
Application.CutCopyMode = False

ActiveWindow.Close

End Function