Versuch der Schadensbegrenzung (ohne Testdaten, daher Nato;-)

Sub Schaltfläche_Datenimport_starten_Klicken()
Dim Drehmoment As Double
Dim Vorspannkraft As Double
Dim Dateipfad As Variant
Dim RngEnde As Range
Dim RwEnde As Long

Application.ScreenUpdating = False
Dateipfad = Application.GetOpenFilename("Alle-Dateien (*.SP8),*.*,", MultiSelect:=True)

Sheets("Variablen").Range("B2").Value2 = UBound(Dateipfad)
laenge = UBound(Dateipfad)



' Kontrolle: MsgBox Laenge
' Kontrolle, ob Dokumente geladen
' Geladen = 1


' Datenimport


For i = 1 To laenge

   On Error Resume Next
   Sheets("Versuch " & i).Activate
   Cells.Clear
   If Err.Number <> 0 Then
      ThisWorkbook.Worksheets.Add after:=ActiveSheet
      ActiveSheet.Name = "Versuch " & i
   End If
   On Error GoTo 0
    
    ActiveSheet.Range("R18").Value2 = Right(Dateipfad(i), Len(Dateipfad(i)) - InStrRev(Dateipfad(i), "\"))
'    Zelle_Zusammenfassung = "A" & (44 + i)
'    Sheets("Zusammenfassung").Range(Zelle_Zusammenfassung).Value2 = "Versuch " & i & " - " & Right(Dateipfad(i), Len(Dateipfad(i)) - InStrRev(Dateipfad(i), "\"))
    
    Range("A10").Select
    
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Dateipfad(i), Destination:=Range("A2"))

        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 29
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = ","
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
    ' Spalten werden gelöscht
    ' Columns("C:H").Select
    ' Selection.Delete Shift:=xlToLeft
    
    ' Wort "Ende" entfernen
    Set RngEnde = _
    Cells.Find(What:="Ende", after:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
    If RngEnde Is Nothing Then Exit Sub
    RngEnde.ClearContents
    RwEnde = RngEnde.Row - 1
    
    ' Überschriften einfügen
    Range("A1").Value = "Drehwinkel [°]"
    Range("B1").Value = "Drehmoment [Nm]"
    'Range("C1").Value = ""
    Range("D1").Value = "Vorspannkraft [kN]"
    Range("H1").Value = "Reibzahl"
    
    
    ' Überschrift fett drucken
    Range("A1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    
     Range("B1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    Columns("B:B").Select
    Selection.NumberFormat = "0.00"
       
     Range("D1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    Columns("D:D").Select
    Selection.NumberFormat = "0.00"
       
     Range("H1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    
    'Oberste Zeile zentrieren + fixieren
    
    Rows("1:1").RowHeight = 23.25
    Rows("1:1").Select
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    
'
    Columns("C:C").Select
    Selection.NumberFormat = "0.00"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Zeit [s]"
    Columns("E:E").Select
    Selection.NumberFormat = "0.00"

    
    ' Spalten_anpassen Makro

    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("A:H").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Columns("H:H").Select
    Selection.NumberFormat = "0.00"
  
'Berechnung der Reibzahl mit Schleife j
   For j = 2 To RwEnde
   On Error Resume Next
   Drehmoment = Range("B" & j).Value
   Vorspannkraft = Range("D" & j).Value
   Range("H" & j) = (((Drehmoment / Vorspannkraft) - (1.25 / (2 * 3.14159))) / ((0.577 * 7.188) + (0.5 * ((8 + 19.5) / 2))))
   If Err.Number <> 0 Then
       Range("H" & j) = False
   End If
   On Error GoTo 0
   Next j
 ' Ende Schleife Reibzahl
 
Next i
    
    
    Sheets("Zusammenfassung").Select
    
    
    Application.ScreenUpdating = True
End Sub