Hallo EXCEL-Freunde,
habe kürzlich aus dem Forum einen Code erhalten (Josef Ehrensberger) für
Datenvergleiche. Nun versuche ich eine Anpassung in der Form, dass bestimmte
Tabellen und Spalten individuell ausgewählt werden können. Dies geschieht
über eine UserForm.
Problem: In einer Zeile muss ich "A65536" in (mySpalte2 & "65536") oder so
ähnlich umbenennen, da "mySpalte2" in einer Combobox als Ziffer "1" ausgewählt
werden kann.
Leider erhalte ich die Fehlermeldung:
Laufzeitfehler 1004
Die Methode 'Range' für das Objekt '_Worksheet' ist fehlgeschlagen
Hier der code (richtig) und mit einer meiner Ideen nach den Fragezeichen
mit der Fehlermeldung:
Dim wks1 As Worksheet, wks2 As Worksheet, wksNeu As Worksheet Dim lng2 As Long, lngNeu As Long, lngRow As Long, rng As Range, sFirst As String If ComboBox1.Text = "" Then MsgBox "Bitte Datei auswählen.", 48, "Hinweis": Exit Sub If ComboBox2.Text <> "" Then Set Tb(1) = Workbooks(ComboBox1.Text).Worksheets(ComboBox2.Text) Else MsgBox "Bitte Tabellenblatt 1 auswählen.", 48, "Hinweis": Exit Sub 'If ComboBox3 = "" Then MsgBox "Beschreibung auswählen.", 48, "Hinweis": Exit Sub If ComboBox4 = "" Then MsgBox "Bitte Suchspalte auswählen.", 48, "Hinweis": Exit Sub If ComboBox5 = "" Then MsgBox "Bitte Ausgangs-Tabelle auswählen.", 48, "Hinweis": Exit Sub myDatei = ComboBox1.Text 'Datei in der gesucht wird myName1 = ComboBox2.Text 'Ausgangs - tabelle myName2 = ComboBox5.Text 'Ziel - tabelle mySpalte = ComboBox4.Text 'Suchspalte in Suchtabelle mySpalte2 = ComboBox6.Text Set wks1 = Sheets(ComboBox2.Text) Set wks2 = Sheets(ComboBox5.Text) Set wksNeu = Sheets("neu") lng2 = IIf(IsEmpty(wks2.Range("A65536")), wks2.Range("A65536").End(xlUp).Row, 65536) ' ? 'lng2 = IIf(IsEmpty(wks2.Range(mySpalte2 & "65536")), wks2.Range(mySpalte2 & "65536").End(xlUp).Row, 65536) lngNeu = IIf(IsEmpty(wksNeu.Range("A65536")), wksNeu.Range("A65536").End(xlUp).Row + 1, 65536) For lngRow = 1 To lng2 Set rng = wks1.Columns(mySpalte).Find(wks2.Cells(lngRow, mySpalte), _ LookIn:=xlValues, LookAt:=xlWhole, after:=wks1.[A65536]) If Not rng Is Nothing Then sFirst = rng.Address rng.EntireRow.Copy wksNeu.Cells(lngNeu, 1) lngNeu = lngNeu + 1 Do Set rng = wks1.Columns(mySpalte).FindNext(after:=rng) If Not rng Is Nothing Then If sFirst = rng.Address Then Exit Do rng.EntireRow.Copy wksNeu.Cells(lngNeu, 1) lngNeu = lngNeu + 1 End If Loop End If Next
Besten Dank für eine Hilfe!
mfg
Erich