Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1444to1448
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Suchergebnis in eine neue Mappe packen

Suchergebnis in eine neue Mappe packen
28.08.2015 18:33:51
Andrea
Hallo ihr Lieben,
seit zwei Tagen versuche ich eigentlich etwas leichtes zu schaffen.
Nachdem ich die Combobox auslese, möchte ich diese Variable in meine Suche aufnehmen und dann das Suchergebnis in eine neue Mappe schreiben.
Leider schaffe ich es nur, das Ergebnis in einem neuen Worksheet zu erzeugen.
Ich habe schon so viele Beiträge und Recherchen durchgeführt, dass ich eher einen Knoten im Kopf habe als die Lösung. Ich bin sicher, ihr könnt mir in Sekunden helfen.
Hier schon mal das, was ich bereits geschrieben habe:
Sub UserForm_Initialize() 'Im Userform gibt es ein paar Comboboxen, die die gleichen Werte haben
On Error Resume Next
Dim j As Integer
For j = 0 To 11
UserForm1.Controls("ComboBox" & j).RowSource = "Tabelle!A1:A4" 'Füllung der ComboBoxen
UserForm1.Controls("ComboBox" & j).ListIndex = 0
Next j
End Sub
Private Sub CommandButton1_Click()  'Suchen Button
Dim firstAddress As String
Dim rng As Range
Dim ws As Worksheet
Dim ErgBlatt As Worksheet
Dim zeile As Long
Const ErgBlattName As String = "Ergebnisse"
Dim wbk As Workbook
Set ErgBlatt = Worksheets.Add
ErgBlatt.Name = ErgBlattName
With Worksheets("Tabelle2").Range("A1:I5000")
Set rng = .Find(UserForm1.ComboBox1.Value, lookat:=xlPart, LookIn:=xlValues) 'Suche
If Not rng Is Nothing Then
firstAddress = rng.Address
Do
zeile = zeile + 1
rng.EntireRow.Copy ErgBlatt.Cells(zeile, 1) 'Funzt super, soll aber in ein neues  _
Workbook
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address  firstAddress
End If
End With
End Sub

Danke für Antworten!!

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchergebnis in eine neue Mappe packen
28.08.2015 20:58:13
Matthias
Hallo Andrea,
etwa so?
 Private Sub '...
Dim wkbNeu As Workbook
Set wkbNeu = Workbooks.Add
wkbNeu.SaveAs "C:\Test\Mappe123.xls"
'// wkb.Neu.SaveAs "C:\Test\ & TextboxName.Text & ".xls"
wkb.Activate 'sicher ist sicher
rng.EntireRow.Copy
wkbNeu.Activate
Tabelle1.Cells(Zeile, 1).Paste
wkb.Activate
Set rng = .FindNext(rng)
End Sub
lg Matthias

AW: Suchergebnis in eine neue Mappe packen
31.08.2015 10:16:01
Andrea
Hi,
danke für die schnelle Antwort, nur leider hängt er sich jetzt an dem "With Worksheets("..."
auf. Er erstellt die neue Mappe, jedoch ist sie leer und es erscheint eine Fehlermeldung mit dem Inhalt:
Objektvariable oder With Blockvariable nicht festgelegt.
Muss ich noch was zusätzlich deklarieren?
Er markiert auch wkb.Activate, obwohl ich weiter oben Dim wkb as Workbook deklariert habe.
Wenn ich das auskommentiere, meckert der die With Worksheets in rot an.
Bin ein wenig überfragt :(

Anzeige
AW: Suchergebnis in eine neue Mappe packen
31.08.2015 13:49:37
Andrea
Huhu,
habe es selber lösen können, nachdem Matthias so gute Tipps gegeben hat:
Sub UserForm_Initialize()
On Error Resume Next
Dim j As Integer
For j = 0 To 11
UserForm1.Controls("ComboBox" & j).RowSource = "Tabell2!A1:A4"
UserForm1.Controls("ComboBox" & j).ListIndex = 0
Next j
End Sub
Private Sub CommandButton2_Click() 'Reset Button
On Error Resume Next
Dim i As Integer
For i = 0 To 11
UserForm1.Controls("ComboBox" & i).ListIndex = 0
Next i
End Sub

Private Sub CommandButton1_Click()  'Suchen Button
Dim firstAddress As String
Dim rng As Range
Dim combo1 As String
Dim zeile As Long
Dim wbkNeu As Workbook
Dim wbk As Workbook
Dim wksNeu As Worksheet
Dim wks As Worksheet
Application.ScreenUpdating = False
Set wbkNeu = Application.Workbooks.Add(1)
wbkNeu.SaveAs "C:\Test\Mappe123.xls"
Set wksNeu = wbkNeu.ActiveSheet
Set wbk = ThisWorkbook
wbk.Activate
With Worksheets("Tabelle1").Range("A1:I5000")
Set rng = .Find(UserForm1.ComboBox1.Value, lookat:=xlPart, LookIn:=xlValues)
If Not rng Is Nothing Then
firstAddress = rng.Address
Do
zeile = zeile + 1
rng.EntireRow.Copy
wksNeu.Cells(zeile, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address  firstAddress
End If
End With
wbkNeu.Activate
Application.ScreenUpdating = True
End Sub
Vielleicht hilft das ja hier auch anderen.
Ich danke euch schon mal sehr!
Tolles Forum hier!
Viele Grüße
Andreas
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige