Hallo zusammen,
ich habe ein Makro mit dem ich Daten aus anderen Excelblättern auslesen möchte. Dies klappt soweit gut, allerdings greift es in den Codezeilen
wsZ.Cells(zeileZ, "E") = ws.Cells(letzteZeile, "L")
wsZ.Cells(zeileZ, "F") = ws.Cells(letzteZeile, "M")
auf die letzte Zeile zu. Diese ist wie folgt definiert:
letzteZeile = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
Leider ist diese Definition nicht ganz korrekt, da die Werte in den auszulesenden Exceldateien nicht die letzten sind. Es soll folgende Bedingung dafür gelten:
Wenn in Spalte D das Wort "Stahlgewicht" steht, dann sollen aus der entsprechenden Zeilen die Werte aus der Spalte L & M ausgelesen werden und in der Zieldatei in E und F eingesetzt werden.
Hat jemand eine Idee? Meine VBA-Kenntnisse sind eher bescheiden, daher hoffe ich auf eure Hilfe.
Zur Verdeutlichung soll anbei das Makro aufgeführt werden:
Option Explicit
Sub DatenAuslesen()
Dim ergebnis As Long
Dim fd As FileDialog
Dim fil As File
Dim fol As Folder
Dim fso As FileSystemObject
Dim letzteZeile As Long
Dim letzteZeileZ As Long
Dim pfad As String
Dim pos As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim wsZ As Worksheet ' Zielblatt
Dim zeichNr As String
Dim zeileZ As Long
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.InitialFileName = ThisWorkbook.Path & "\"
ergebnis = fd.Show
If ergebnis = 0 Then
' MsgBox Prompt:="Abbruch durch den Benutzer"
Exit Sub
End If
pfad = fd.SelectedItems(1)
Set wsZ = ThisWorkbook.Worksheets("Ziel")
letzteZeileZ = wsZ.Cells(wsZ.Rows.Count, "A").End(xlUp).Row
Set fso = New FileSystemObject
Set fol = fso.GetFolder(pfad)
zeileZ = letzteZeileZ + 1
For Each fil In fol.Files
If fil.Name Like "*.xls*" And _
Len(fil.Name) <= 25 Then
Set wb = Workbooks.Open(Filename:=fil.Path)
For Each ws In wb.Worksheets
letzteZeile = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
If ws.Cells(letzteZeile, "D") = "Stahlgewicht" Then
wsZ.Cells(zeileZ, "A") = ws.Range("F3")
wsZ.Cells(zeileZ, "B") = ws.Range("F4")
wsZ.Cells(zeileZ, "C") = ws.Range("O3")
' wsZ.Cells(zeileZ, "D") = ws.Range("L3") ' Alternative für Zeichnungsnummer
pos = InStrRev(fil.Name, ".")
zeichNr = Left$(fil.Name, pos - 1)
wsZ.Cells(zeileZ, "D") = zeichNr
wsZ.Cells(zeileZ, "E") = ws.Cells(letzteZeile, "L")
wsZ.Cells(zeileZ, "F") = ws.Cells(letzteZeile, "M")
zeileZ = zeileZ + 1
End If
Next ws
wb.Close SaveChanges:=False
End If
Next fil
Set fso = Nothing
End Sub |