Zellen aus nicht aktiver Tabelle Kopieren VBA

[michel34497]

Hallo!

Ich brauche dringende Hilfe, bei einem Code der zusammengebastelt wurde. Ich habe eine UserForm in der werden Daten in zwei ListBoxen eingelesen.
In ListBox1 stehen die Daten aus der Tabelle TEST und in ListBox2 die Daten aus der Tabelle Data.
Was ich alles machen kann und auch hinbekommen habe ist:
Daten in der Listbox1 Löschen (Diese werden auch in der Tabelle Test gelöscht)
Werte Aus ListBox2 in ListBox1 einfügen
Mit einen SpinButton2 die Werte in der ListBox1 hin und her verschieben.
Das alles geht.
Was ich jetzt brauche und schon teilweise realisiert habe ist:
Wenn Werte aus der listBox2 in die ListBox1 eingetragensind, soll der Code Vergleichen ob es diese Werte in der Tabelle TEST schon vorhanden sind.
Sind sie nicht vorhanden soll eine neue Leerzeile eingefügt werden. Geht Auch

Jetzt soll der Code die Werte die nicht in der ListBox1 und der Tabelle TEST stehen, aus der Tabelle Data einlesen.

Und dort habe ich im moment das Problem.
Ich weiß in welcher Zeile und und Spalte der Wert steht
Ich muß erst die Tabelle Data Aktivieren das der bereich Kopiert wird.

Möchte aber NICHT das TabellenBlatt aktivieren.

Wie Kann man das Lösen?
Hier der ganze Code

Code:

Private Sub CommandButton4_Click()
ReDim werte1(ListBox1.ListCount)
ReDim werte2(ListBox2.ListCount)
Dim Zeile As Long
With ListBox1
 For i = 0 To .ListCount - 1
 .Selected(i) = True
Next
 
   varKategorie = Range(.Tag).Cells(1).Offset(, -1).Value
   For intListBox = 0 To ListBox1.ListCount - 1
     If .Selected(intListBox) Then
       werte1(intListBox) = ListBox1.List(intListBox)

       MB = Range(.Tag).Rows(intListBox + 1).Cells(1).Value 'Range(.Tag).Rows(I + 1).Value
 'ListBox und Tabelle Vergleichen
       If MB = werte1(intListBox) Then
               'MsgBox "Werte stimmen überein!"
               
           Else
               MsgBox "Werte sind nicht gleich!"
                ro = Range(.Tag).Row
                co = Range(.Tag).Column
              'Zeile und Spalte B-1 bis B+8 Einfügen und nach unten verschieben
                Range(Cells(ro + intListBox, co - 1), Cells(ro + intListBox, co + 8)).Insert Shift:=xlDown
               
               loDeinWert = werte1(intListBox) 'gesuchter Wert
               Set rng = Worksheets("Data").Range("I:I").Find(loDeinWert)
               If rng Is Nothing Then
                 MsgBox "Wert " & loDeinWert & " nicht gefunden!"
               Else
                   
                   rt = rng.Row
                   ct = rng.Column
                   Worksheets("Data").Activate
                   Range(Cells(rt, ct), Cells(rt, ct + 8)).Copy
                       
                       MsgBox "Der Begriff  """ & loDeinWert & """  wurde in Zeile " & _
                       rt & " und Spalte " & ct & " gefunden.", _
                       64, "   Information für " & Application.UserName
                   End With
                   
                   Worksheets("TEST").Activate
                   'rng.EntireRow.Copy
                   Worksheets("TEST").Cells(Rows.Count, "B").End(xlUp) _
                     .Offset(1, 0).PasteSpecial Paste:=xlPasteAll
               End If
       End If
     End If
   'Next i
   
   Next intListBox
End With


For intListBox = 0 To ListBox1.ListCount - 1
   If ListBox1.Selected(intListBox) Then
       intAusgabe = ListBox1.List(intListBox) 'intAusgabe zeigt mir den wert aus der Listbox an
   End If
Next
End Sub

Es geht Darum

Code:

                   rt = rng.Row
                   ct = rng.Column
                   Worksheets("Data").Activate
                   Range(Cells(rt, ct), Cells(rt, ct + 8)).Copy

Wie muß ich das änder?

Was ich sonst und überhaubt nicht gerne mache aber diesmal brauche eine schnelle Hilfe
Ganz schnelle Hilfe ODER zumidestens Tip's
Was ich noch vergessen Habe der Code ist im CommandButton4

Tausend Dank an alle die mir helfen
Bei Fragen oder sonstigen einfach schreiben!

[Steffl]

Hallo Michael,

ungetestet

Code:

                  rt = rng.Row
                  ct = rng.Column
                  With Worksheets("Data")
                      .Range(.Cells(rt, ct), .Cells(rt, ct + 8)).Copy
                  End With

[michel34497]

Hallo!
Probiert schon vorher.
Bekomme die Meldung Objektvariable   (Kurzvassung)

[michel34497]

Hallo!
Bekomme dei Meldung nicht mehr! Warum auch immer  

Wie kann ich jetzt die Kopierten Zeilen in Das TabellenBlatt Test an die entsprechende Zeile einfügen?

Oder wie she ich was der Code Kopiert hat

Danke schon mal!

[Steffl]

Hallo Michael,

bei meinen Test war zumindest ein End With zuviel. Die Kopierzeile mußt du anpassen. Ich habe den Code auch ein wenig besser eingerückt. Bei deinen kennt man sich nicht aus.

Code:

Private Sub CommandButton4_Click()
   ReDim werte1(ListBox1.ListCount)
   ReDim werte2(ListBox2.ListCount)
   Dim Zeile As Long
   With ListBox1
      For i = 0 To .ListCount - 1
         .Selected(i) = True
      Next
        
      varKategorie = Range(.Tag).Cells(1).Offset(, -1).Value
      For intListBox = 0 To ListBox1.ListCount - 1
         If .Selected(intListBox) Then
            werte1(intListBox) = ListBox1.List(intListBox)
            
            MB = Range(.Tag).Rows(intListBox + 1).Cells(1).Value 'Range(.Tag).Rows(I + 1).Value
            'ListBox und Tabelle Vergleichen
            If MB = werte1(intListBox) Then
               'MsgBox "Werte stimmen überein!"
            
            Else
               MsgBox "Werte sind nicht gleich!"
               ro = Range(.Tag).Row
               co = Range(.Tag).Column
               'Zeile und Spalte B-1 bis B+8 Einfügen und nach unten verschieben
               Range(Cells(ro + intListBox, co - 1), Cells(ro + intListBox, co + 8)).Insert Shift:=xlDown
              
               loDeinWert = werte1(intListBox) 'gesuchter Wert
               Set rng = Worksheets("Data").Range("I:I").Find(loDeinWert)
               If rng Is Nothing Then
                  MsgBox "Wert " & loDeinWert & " nicht gefunden!"
               Else
              
                  rt = rng.Row
                  ct = rng.Column
                  With Worksheets("Data")
                     .Range(.Cells(rt, ct), .Cells(rt, ct + 8)).Copy Worksheets("Test").Range("A1")
                  End With
                  
                  MsgBox "Der Begriff  """ & loDeinWert & """  wurde in Zeile " & _
                  rt & " und Spalte " & ct & " gefunden.", _
                  64, "   Information für " & Application.UserName
                  
                  Worksheets("TEST").Activate
                  'rng.EntireRow.Copy
                  Worksheets("TEST").Cells(Rows.Count, "B").End(xlUp) _
                  .Offset(1, 0).PasteSpecial Paste:=xlPasteAll
               End If
            End If
         End If
         'Next i
      
      Next intListBox
   End With
  
  
   For intListBox = 0 To ListBox1.ListCount - 1
      If ListBox1.Selected(intListBox) Then
         intAusgabe = ListBox1.List(intListBox) 'intAusgabe zeigt mir den wert aus der Listbox an
      End If
   Next
End Sub

[michel34497]

Hallo!
Danke erstmal!
Habe leider bei der Test Datei vergessen was raus zu löschen!
Sorry!
Werde das mal umsezten!!
Danke nochmal für die schnelle Hilfe! :100: Werde dir irgenwann mal auf den treffen wenn ich da bin :15:

[Rabe]

Hi Stefan,

ungetestet

da würde doch auch:

Code:

Worksheets("Data").Range(Cells(rt, ct), Cells(rt, ct + 8)).Copy Worksheets("Test").Range("E15")

gehen oder?

Wenn E15 die "entsprechende Zelle" ist.

[Steffl]

Hallo Ralf,

da würde doch auch:

Code:

Worksheets("Data").Range(Cells(rt, ct), Cells(rt, ct + 8)).Copy Worksheets("Test").Range("E15")

gehen oder?

Wenn E15 die "entsprechende Zelle" ist.

das funktioniert aber nur wenn das Worksheet "Data" das aktive Tabellenblatt ist.

[Rabe]

Hi Stefan,

echt? Da wird doch explizit auf das Worksheet "Data" Bezug genommen. Es ist doch dann egal, welches das aktive ist.

[Steffl]

Hallo Ralf,

ja, ist echt so. Würde dieser Code in einem Tabellenmodul stehen, nimmt deine Variante bei den Cells-Angaben explicit auf das Tabellenmodul den Bezug.