Guten Tag,
1. ich möchte von Excel Datei "Rechnungen1", die aus 23 Tabellenblätter ("Tabelle1,Tabelle2...immer von Zeile 5 bis Zeile 1800 bzw die letzte Zeile mit Werten (Spaltenbreite bis AN) besteht, die kopieren und untereinander zusammen in ein vorhandenes Tabellenblatt "Master" /eine neue Datei "Rechnungszusammenfassung" einfügen.
Hier bräucht ich eine Hilfestellung.
2. Was ich bisher habe ist folgender Code, der aber nicht sonderlich gut funktionieren will. Will ich den Code in eine andere Exceldatei einfügen, bekomme ich immer den Fehler: "Fehler beim Kompilieren. Benutzerdefinierter Typ nicht definiert"(Ja er soll in andere Dateien, da dort sehr viele Formeln hinterlegt sind die auf den ersten Sheet mit "Master" gesteuert sind. Ein großen Vorteil hat der Code->Man kann ihn auf verschiedene "Rechnungen"-Dateien anwenden (solange die Arbeitsblätter gleich heißen). Denn es sollen verschiedene Rechnungen unabhängig voneinander aktualisiert und ausgewertet werden.
Function GetConnXLS(ByVal cFileName As String, _
Optional ByVal InformErrMSG As Boolean = False) As ADODB.Connection
'On Error GoTo LOI:
'Open ADO connection to excel workbook
Dim oConn As ADODB.Connection
Dim Ext As String, ConnStr As String
Set oConn = New ADODB.Connection
ConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & cFileName & ";" & _
"Extended Properties=""Excel 12.0 xml;HDR=Yes"";"
oConn.Open ConnStr
Set GetConnXLS = oConn
Exit Function
LOI:
If Err.Number <> 0 Then
Set oConn = Nothing
If InformErrMSG Then
MsgBox "GetConnXLS" & ": " & Err.Number & " " & Err.Description, vbCritical
End If
End If
End Function
Sub Merge_All()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sh As Worksheet
Dim I As Long, k As Long, CountFiles As Long, J As Long, strData, _
kDS As Long, xKorr As Integer
files = Application.GetOpenFilename(, , , , True)
If VarType(files) = vbBoolean Then Exit Sub
Set sh = Sheets("Master")
For k = LBound(files) To UBound(files)
'Anzahl der Datensätze in der ausgewählten DAtei ermitteln
kDS = lastRowClosedFile(files(k), "Master", "A:A")
'ADODB-Connection erstellen
Set cnn = GetConnXLS(files(k))
If cnn Is Nothing Then
MsgBox "Check lai co so du lieu file: " & files(k)
Exit Sub
End If
'Select-Befehl zusammenstellen
strData = "SELECT * From [Tabelle1$A5:AN" & kDS & "];"
'Recordset öffnen auf der Grundlage der Connection & Select-Befehl
Set rst = cnn.Execute(strData)
CountFiles = CountFiles + 1
If CountFiles = 1 Then
For J = 0 To rst.Fields.Count - 1
sh.Cells(3, J + 1).Value = rst.Fields(J).Name
Next J
End If
If k = 1 Then
xKorr = 1
Else
xKorr = 0
End If
sh.Range("I" & 4 + I - xKorr).Value = files(k)
I = I + sh.Range("A" & 4 + I).CopyFromRecordset(rst)
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
Next k
MsgBox "Done", vbSystemModal + 48, "Hurraaa..."
End Sub
Function lastRowClosedFile(ByVal FileName As String, SheetName As String, TargetRange As String) As Long
Dim objADO As Object
On Error Resume Next
Set objADO = ExcelTable(FileName, SheetName, TargetRange)
lastRowClosedFile = objADO.RecordCount + 1
objADO.Close
End Function
Private Function ExcelTable(ByRef Path As String, ByRef Table As String, ByRef SourceRange As String) As Object
Dim SQL As String
Dim Con As String
SQL = "select * from [" & Table & "$" & SourceRange & "]"
If Mid(Path, InStrRev(Path, ".") + 1) = "xls" Then
Con = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Extended Properties=Excel 8.0;" _
& "Data Source=" & Path & ";"
ElseIf Mid(Path, InStrRev(Path, ".") + 1) Like "xls?" Then
Con = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Extended Properties=""Excel 12.0;HDR=YES"";" _
& "Data Source=" & Path & ";"
Else
Exit Function
End If
Set ExcelTable = CreateObject("ADODB.Recordset")
ExcelTable.Open SQL, Con, 3, 1
End Function
Falls mir jemand helfen kann, dem wäre ich sehr Dankbar.
Grüßle
Vanessa
|