hier noch der code:
Option Explicit
Sub Daten_kopieren()
Dim Pfad As String, Dateiname As String, iRow As Long
Application.ScreenUpdating = False
Pfad = "F:\RKA\Kfz\JA2008\NK und LZB\von Gesellschaft\Forms\"
Dateiname = Dir(Pfad & "*.xls")
Do While Dateiname <> ""
Workbooks.Open Filename:=Pfad & Dateiname
iRow = ThisWorkbook.Sheets("form").Range("A65536").End(xlUp).Offset(1, 0).Row
Workbooks(Dateiname).Sheets("form").Range("J6").Copy
ThisWorkbook.Sheets("form").Cells(iRow, 1).PasteSpecial
Workbooks(Dateiname).Sheets("form").Range("J8").Copy
ThisWorkbook.Sheets("form").Cells(iRow, 2).PasteSpecial
Workbooks(Dateiname).Sheets("form").Range("J14").Copy
ThisWorkbook.Sheets("form").Cells(iRow, 3).PasteSpecial
Workbooks(Dateiname).Sheets("form").Range("J126").Copy
ThisWorkbook.Sheets("form").Cells(iRow, 4).PasteSpecial
Workbooks(Dateiname).Sheets("form").Range("J217").Copy
ThisWorkbook.Sheets("form").Cells(iRow, 5).PasteSpecial
Workbooks(Dateiname).Sheets("form").Range("J219").Copy
ThisWorkbook.Sheets("form").Cells(iRow, 6).PasteSpecial
Workbooks(Dateiname).Sheets("form").Range("J252").Copy
ThisWorkbook.Sheets("form").Cells(iRow, 7).PasteSpecial
Workbooks(Dateiname).Sheets("form").Range("J156").Copy
ThisWorkbook.Sheets("form").Cells(iRow, 8).PasteSpecial
Workbooks(Dateiname).Sheets("form").Range("J257").Copy
ThisWorkbook.Sheets("form").Cells(iRow, 9).PasteSpecial
Workbooks(Dateiname).Sheets("form").Range("J371").Copy
ThisWorkbook.Sheets("form").Cells(iRow, 10).PasteSpecial
Workbooks(Dateiname).Close
Dateiname = Dir()
Loop
End Sub