wer kann mir helfen? Ich habe aus dem Forum einen Code von Josef Ehrensberger gefunden
(Orinal weiter unten) und auf meine Bedürfnisse umgeschrieben.
Der Code soll mir aus den gleichmäßig aufgebauten Dateien (ca. 30) 10 Werte herauskopiern
Text und auch Zahl.
Der Code funktioniert wenn nur 3 Werte herauskopiert werden. Bei 4 Werten bricht das Makro
nach 20 Schleifen mit der Meldung "400" ab.
Was läuft falsch?
Bin für jede Info dankbar.
Tschüs Werner
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub Daten_Lesen()
Dim strPath As String, strFile As String, strTabName As String
Dim lngR As Long, Monate As Long, Jahr As Long
Monate = Range("A1") 'zelle mit den Monaten (z.B 8)
Jahr = Range("A2") 'zelle mit dem Jahr (z.B 2009)
strPath = "C:\Test\Protokolle\Tagesprotokolle\" & Jahr & "\" & Monate & "\" 'Verzeichnis _
anpassen!
strTabName = "Tabelle1" 'Name der Tabellenblätter anpassen!
strFile = Dir(strPath & "*.xls")
lngR = 4 'Für Zeile 4
With ThisWorkbook.Sheets("Tabelle1") 'Name der Ausgabetabelle anpassen!
.Range("A5:L" & Rows.Count).ClearContents 'Spalten löschen
Do Until strFile = ""
lngR = lngR + 1
.Cells(lngR, 1) = strFile
.Cells(lngR, 2).Formula = "=('" & strPath & "[" & strFile & "]" & _
strTabName & "'!$b$32)" '1.Text übernommen
.Cells(lngR, 2) = .Cells(lngR, 2).Value
.Cells(lngR, 3).Formula = "=('" & strPath & "[" & strFile & "]" & _
strTabName & "'!$b$33)" '2.Text übernommen
.Cells(lngR, 3) = .Cells(lngR, 3).Value
.Cells(lngR, 4).Formula = "=('" & strPath & "[" & strFile & "]" & _
strTabName & "'!$b$34)" '3.Text übernommen
.Cells(lngR, 4) = .Cells(lngR, 4).Value
strFile = Dir
.Cells(lngR, 5).Formula = "=('" & strPath & "[" & strFile & "]" & _ '
########################
--------ORGINAL--------
Hallo Stefan,
probier mal diesen Code. (Kommentare beachten!)
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub Daten_Lesen()
Dim strPath As String, strFile As String, strTabName As String
Dim lngR As Long
strPath = "F:\Temp\km\" 'Verzeichnis anpassen!
strTabName = "Tabelle1" 'Name der Tabellenblätter anpassen!
strFile = Dir(strPath & "*.xls")
lngR = 1
With ThisWorkbook.Sheets("Tabelle1") 'Name der Ausgabetabelle anpassen!
.Range("A2:B" & Rows.Count).ClearContents
Do Until strFile = ""
lngR = lngR + 1
.Cells(lngR, 1) = strFile
.Cells(lngR, 2).Formula = "=SUM('" & strPath & "[" & strFile & "]" & _
strTabName & "'!$K$7:$K$17)"
.Cells(lngR, 2) = .Cells(lngR, 2).Value
strFile = Dir
Loop
End With
End Sub