Hallo nochmal,
also ich hab jetzt ansonsten nicht weiter geschaut. Aber ich denke, dass dein Code ansonsten funktioniert. Habe nur eine Zeile geaendert. Kommentar ist eingefuegt dazu. Hier wird als Startzeile nicht mehr 19 festgelegt, sondern die erste freie Zeile, die in Spalte B gefunden wird. Das sollte ja funktionieren, wenn in Zeile 18 Ueberschriften sind (sonst nochmal melden). Solltest du die Suche auf eine andere Spalte aendern wollen, aendere einfach die Spaltennummer hinter Rows.Count.
Sub ImportDaten2()
ActiveSheet.Unprotect Password:="xxxx"
Dim oMe As Worksheet, iZeile As Long, oDatei As Object
Dim oFS As Object, wbQuelle As Workbook, sBlatt As String
Set oMe = ThisWorkbook.ActiveSheet
Const sDateiPfad As String = "Pfad vom Laufwerk"
iZeile = oMe.Cells(Rows.Count, 2).End(xlUp).Row + 1 'erste freie Zeile in Spalte B suchen
Application.ScreenUpdating = False
Set oFS = CreateObject("Scripting.FileSystemObject")
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
If InStrRev(oDatei.Name, "xlsx") Then
sBlatt = "Tabelle1"
oMe.Cells(iZeile, 2) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C3"))
oMe.Cells(iZeile, 3) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C5"))
oMe.Cells(iZeile, 4) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C6"))
oMe.Cells(iZeile, 5) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C7"))
oMe.Cells(iZeile, 6) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C8"))
oMe.Cells(iZeile, 7) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C9"))
oMe.Cells(iZeile, 8) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C10"))
oMe.Hyperlinks.Add Anchor:=oMe.Cells(iZeile, 30), Address:=sDateiPfad _
& oDatei.Name, TextToDisplay:=oDatei.Name
iZeile = iZeile + 1
End If
Next
Set oMe = Nothing: Set wbQuelle = Nothing
ActiveSheet.Protect Password:="xxxx"
End Sub
Gruss Tor
|