Sub DatenEinfügen()
Dim MySheet As Worksheet
Dim strPath As String
Dim strFile As String
Dim wkbInput, Messbericht As Workbook
Dim wksInput As Worksheet
Dim lngTargetRow As Long
Dim lRow As Long
Dim lCol As Long
Dim i As Integer
Application.DisplayAlerts = False
Delta = 0
Set MySheet = ActiveSheet
Set Messbericht = ActiveWorkbook
strPath = ActiveWorkbook.Path
strFile = Dir(strPath & "\*.xlsx")
Do While strFile <> ""
If strFile = ActiveWorkbook.Name Then
Else
Set wkbInput = Application.Workbooks.Open(strPath & "\" & strFile)
i = 2
Do Until wkbInput.Worksheets(i).Name = "1"
Set wksInput = wkbInput.Worksheets(i)
wksInput.Activate
wksInput.Range("=L7:AQ7").Select
Selection.Copy
Messbericht.Activate
Worksheets(i).Activate
Worksheets(i).Range("=A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
i = i + 1
Loop
wkbInput.Close
Set wkbInput = Nothing
End If
strFile = Dir
Loop
End Sub