Hilfe!!!

Sub ESAComp()
'Dateiname_ausgeben()
Meine_Datei = InputBox("Bitte geben sie den Dateinamen (ohne Endung) der zu verarbeitenden Excel Datei an. Sie muss bereits geöffnet sein.", "Dateieingabe")
Meine_Datei = Meine_Datei & ".xls"
'Tabellenblaetter_zählen()
Windows(Meine_Datei).Activate
max = Worksheets.Count
'Makroname_ausgeben()
Mein_Export = InputBox("Name der Textdatei (ohne Endung) .", "Dateieingabe")
Mein_Export = Mein_Export & ".xls"
'MsgBox Mein_Export, , "Exportiert wird in:"
'Excel Datei mit dem Namen Mein_Export und einem Sheet erstellen
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=Mein_Export
ActiveWorkbook.Save
For i = 2 To max
'Quell Tabellenblatt auswählen()
Windows(Meine_Datei).Activate
Mein_Blatt = Worksheets(i).Name
Worksheets(i).Activate
Range("A1").Select
phys = ActiveCell.Value
Select Case phys
Case Is = "REINFORCED PLY"
Call Riinforsd_pläi
Case Is = "HOMOGENEOUS PLY"
Call Homogeneous_Ply
Case Is = "ADHESIVE"
Call Adhesive
Case Is = "CORE PLY, HONEYCOMB"
Call CorePlyhoneycomb
Case Is = "CORE PLY, HOMOGENEOUS"
Call CorePlyHomogeneous
End Select
Next i
Windows(Mein_Export).Activate
Call Leerzeilen_loeschen
Call Abstandszeile_einfügen
Call Sterne_einfügen
Call Spalten_verschieben
Call Export_Textdatei
'SI Einheiten
End Sub

Sub Leerzeilen_loeschen()
Dim j As Double
Application.ScreenUpdating = False
For j = (i - 1) * 140 + 120 To 2 Step -1
If Cells(j, 1).Value = "" Then _
Cells(j, 1).EntireRow.Delete
Next j
Application.ScreenUpdating = True
End Sub

Sub Abstandszeile_einfügen()
Dim k As Integer
For k = 1 To Range("A65536").End(xlUp).Row
If Range("A" & k).Value = "Other data = " Or Range("A" & k).Value = "name = " Then
Rows(k + 1).Insert
Range(Cells(k + 1, 1).Address).Select
ActiveCell.FormulaR1C1 = "#---------------------------------------------------------------------------------"
End If
Next k
Range("A1").Select
ActiveCell.FormulaR1C1 = "#---------------------------------------------------------------------------------"
End Sub

Sub Sterne_einfügen()
Dim l As Integer
Dim l2 As Integer
For l = 1 To Range("A65536").End(xlUp).Row
If Range("A" & l).Value = "Manufacturer = " Then
For l2 = l To Range("A65536").End(xlUp).Row
Range("A" & l2).Value = "#" & Range("A" & l2).Value
If Range("A" & l2).Value = "#Other data = " Then Exit For
Next l2
End If
Next l
End Sub

Sub Spalten_verschieben()
Windows(Mein_Export).Activate
Range("C1").Select
ActiveCell.FormulaR1C1 = "=RC[-2]:R[3]C[-2]&RC[-1]:R[3]C[-1]"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C1000"), Type:=xlFillDefault
Range("C1:C1000").Select
Selection.Copy
Range("D1:D1000").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("D1:D1000").Select
Application.CutCopyMode = False
Selection.Copy
Range("A1:A1000").Select
ActiveSheet.Paste
Range("B1:D1000").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
End Sub

Sub Export_Textdatei()
Dim fso As Object
Dim txt As Object
Dim z As Integer
Dim s As Integer
Dim temp As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set txt = fso.CreateTextFile("D:\ESAComp Things\Material Datenbank\Textdatei.txt")
For z = 1 To ActiveSheet.UsedRange.Rows.Count
For s = 1 To ActiveSheet.UsedRange.Columns.Count
temp = temp & Cells(z, s)
Next s
txt.WriteLine temp
temp = ""
Next z
Set fso = Nothing
Set txt = Nothing
MsgBox "Textdatei ""D:\.txt""" & "wurde erfolgreich erstellt!"
End Sub

Sub Riinforsd_pläi()