Suchergebnis in eine neue Mappe packen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Suchergebnis in eine neue Mappe packen
von: Andrea
Geschrieben am: 28.08.2015 18:33:51

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!!

Bild

Betrifft: AW: Suchergebnis in eine neue Mappe packen
von: Matthias
Geschrieben am: 28.08.2015 20:58:13
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

Bild

Betrifft: AW: Suchergebnis in eine neue Mappe packen
von: Andrea
Geschrieben am: 31.08.2015 10:16:01
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 :(

Bild

Betrifft: AW: Suchergebnis in eine neue Mappe packen
von: Andrea
Geschrieben am: 31.08.2015 13:49:37
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

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Suchergebnis in eine neue Mappe packen"