1 2 3 4 5 | Guten Tag zusammen
Wenn ich das Script ausführen will, poppt immer bei oMe = die Fehlermeldung auf, "Fehler beim Kompilieren".
Kann ich die erste Zeile umschreiben, und wie, oder gibt es noch andere Möglichkeiten?
Das Script liest aus Tabellen in einem geschlossenen Ordner in die aktuell geöffnete Tabelle.
Lieben Dank für jeden Hinweis.
|
1 | Set oMe = ThisWorkbook.ActiveSheet
|
Sub GetData()
Set oMe = ThisWorkbook.ActiveSheet 'ZielDatei/-Tabelle (= die aktuelle Tabelle der aktuellen Datei)
Const sDateiPfad As String = "\\Lauwerk....\" 'Pfad für zu durchsuchende Excel-Dateien; mit Backslash am Ende
sZelle1 = "B4" 'auszulesende Zelle
sZelle2 = "B12" 'weitere auszulesende Zelle
sZelle3 = "B13" 'weitere auszulesende Zelle
sZelle4 = "B14" 'weitere auszulesende Zelle
sZelle5 = "B15" 'weitere auszulesende Zelle
sZelle6 = "B16" 'weitere auszulesende Zelle
sZelle7 = "B21" 'weitere auszulesende Zelle
sZelle8 = "B24" 'weitere auszulesende Zelle
sZelle9 = "B25" 'weitere auszulesende Zelle
sZelle10 = "B32" 'weitere auszulesende Zelle
sZelle11 = "B23" 'weitere auszulesende Zelle
sZelle12 = "G26" 'weitere auszulesende Zelle
sZelle13 = "H45" 'weitere auszulesende Zelle
sZelle14 = "B26" 'weitere auszulesende Zelle
sZelle15 = "B27" 'weitere auszulesende Zelle
sZelle16 = "G23" 'weitere auszulesende Zelle
iZeile = 19 'ab Zeile 2 in Zieltabelle eintragen
iSpalte = 2 'ab Spalte A in Zieltabelle eintragen
Set oFS = CreateObject("Scripting.FileSystemObject")
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
sWbName = oDatei.name
If Left(LCase(oFS.GetExtensionName(sWbName)), 3) = "xls" Then
Workbooks.Open (sDateiPfad & sWbName)
'Spalten definieren
oMe.Cells(iZeile, iSpalte).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle1).Value
oMe.Cells(iZeile, iSpalte + 1).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle2).Value
oMe.Cells(iZeile, iSpalte + 2).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle3).Value
oMe.Cells(iZeile, iSpalte + 3).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle4).Value
oMe.Cells(iZeile, iSpalte + 4).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle5).Value
oMe.Cells(iZeile, iSpalte + 5).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle6).Value
oMe.Cells(iZeile, iSpalte + 6).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle7).Value
oMe.Cells(iZeile, iSpalte + 7).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle8).Value
oMe.Cells(iZeile, iSpalte + 8).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle9).Value
oMe.Cells(iZeile, iSpalte + 9).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle10).Value
oMe.Cells(iZeile, iSpalte + 10).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle11).Value
oMe.Cells(iZeile, iSpalte + 11).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle12).Value
oMe.Cells(iZeile, iSpalte + 12).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle13).Value
oMe.Cells(iZeile, iSpalte + 13).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle14).Value
oMe.Cells(iZeile, iSpalte + 14).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle15).Value
oMe.Cells(iZeile, iSpalte + 15).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle16).Value
'spalte erweitern
oMe.Hyperlinks.Add Anchor:=oMe.Cells(iZeile, iSpalte + 27), Address:=sDateiPfad & sWbName, TextToDisplay:=sWbName
Workbooks(sWbName).Saved = True
Workbooks(sWbName).Close
iZeile = iZeile + 1
End If
Next
End Sub
|