daten auslesen

Sub auslesen() 'nebeneinander
Dim rngAct As Range
Dim iCol As Integer
Dim lgrow As Long
Dim wksZiel As Worksheet
Dim wksQuell As Worksheet
On Error Resume Next
Set wksQuell = ThisWorkbook.Sheets("Besuchsbericht")
Workbooks.Open FileName:="\\STABIFIX01\ablage\tmp\Reiseberichte\Datenbank\DB.xls"
Sheets("tabelle1").Unprotect "ni7888"
Set wksZiel = ActiveWorkbook.Sheets("tabelle1")
With wksZiel
lgrow = .Range("a65536").End(xlUp).Row + 1
iCol = 0
For Each rngAct In wksQuell.Range("a4:f4,C6,d6,e6,d7,e7,d8,e8,f6:f8,e1,b14").Cells
iCol = iCol + 1
.Cells(lgrow, iCol) = rngAct
Next rngAct
End With
Application.CutCopyMode = False
End Sub