SET zuweisen
11.11.2005 09:43:53
Regina
ich habe ein Probelm, ich möchte 2 Tabellen miteinander vergleichen, die in verschiedenen Dateien stehen. und in verschiednen Verzeichnissen.
Tab1
"U:\201.2\Kontoauszüge\UMSATZ_200352069900_" & Datum & "064500.xls"
Hier heisst die Tabelle KH401
Tab2
"U:\201.2\Aktion EA\AnforderungenO+W_gesamt_ 011105.xls"
Hier ist es die Tabelle "Anfordern"
Hier mal der Code :
er meckert in der Zeile
Set tb2 = Worksheets("Anfordern") ' INDEX Außerhalb des gültigen Bereichs
Wäre schön, wenn jemand helfen kann.
Gruß Regina
Sub KH401AusTabSuchen()
'tab1 vergleichen mit tab2, wenn gleich dann tab2 Zeilen
'in tab3 kopieren und Zähler setzen.
ChDir "U:\201.2\Aktion EA"
Workbooks.Open Filename:= _
"U:\201.2\Aktion EA\AnforderungenO+W_gesamt_ 011105.xls"
Dim Datum As Long
Datum = Format(Date, "DD") & Format(Date, "MM") & Format(Date, "YY")
ChDir "U:\201.2\Kontoauszüge\"
Workbooks.Open Filename:= _
"U:\201.2\Kontoauszüge\UMSATZ_200352069900_" & Datum & "064500.xls"
Sheets("KH401").Activate
Dim i As Long
Dim c As Long
Dim tb1 As Worksheet
Dim VSN As String
Dim tb2 As Worksheet
Dim counter As String
Dim intAnfang As Integer
Dim intEnde As Integer
Dim ENDE1 As Long
Dim ENDE2 As Long
Set tb1 = Worksheets("KH401") 'Tabellennamen eintragen
Set tb2 = Worksheets("Anfordern")
counter = 1
ENDE1 = tb1.Cells(65536, 1).End(xlUp).Row 'von letzter Zeile aufwärts
ENDE2 = tb2.Cells(65536, 1).End(xlUp).Row
i = 2
c = 2
intAnfang = 2
For i = 2 To ENDE1
If tb1.Cells(i, 2) <> "" Then
VSN = tb1.Cells(i, 2) '.Value
For c = 2 To ENDE2
Application.StatusBar = i & " Von " & c
If tb2.Cells(c, 2) = VSN Then
If tb2.Cells(c, 2) <> tb2.Cells(c - 1, 2) And _
tb2.Cells(c, 2) = VSN Then
intAnfang = c
End If
If tb2.Cells(c + 1, 2) <> tb2.Cells(c, 2) Then
intEnde = c
tb2.Range(Cells(intAnfang, 16), tb2.Cells(intEnde, 16)) = counter
tb1.Cells(i, 3) = counter
Sheets(2).Rows(intAnfang & ":" & intEnde).Copy
Sheets(3).Cells(65536, 1).End(xlUp).Offset(1, 0).EntireRow.PasteSpecial
counter = counter + 1
Application.CutCopyMode = False
Exit For
End If
End If
Next
End If
Next
Application.StatusBar = False
End Sub