schnufflchen
Goto Top

Zeile kopieren und in neues Tabellenblatt einfügen

Hallo,
ich habe mal wieder ein Problem.
Ich habe zwei Tabellenblätter (Tab1 und Tab2). In Tab1 steht in Spalte F Werte (ab Zeile 2). Wenn dieser Wert in Spalte 1 auf Tab2 gefunden wird, dann soll die komplette Zeile aus Tab1 unterhalb des gefundenen Wertes in Tab2 eingefügt werden. Das Suchen und finden klappt schon, aber bei dem Einfügen hab ich noch Probleme, weil eben das Tabellenblatt gewechselt wird. Ich hoffe es ist einigermaßen verständlich und mir kann jemand wieder so toll weiterhelfen, wie beim letzten Mal.
Dankeschön schon mal im Voraus

Content-ID: 120780

Url: https://administrator.de/contentid/120780

Ausgedruckt am: 05.11.2024 um 16:11 Uhr

Wolfsburger
Wolfsburger 19.07.2009 um 14:22:56 Uhr
Goto Top
Worüber sprechen wir hier? Microsoft Excel? Openoffice? Stift und Papier? Datenbanken in Access, SQL, Oracle? Welche Programmversion?
Schnufflchen
Schnufflchen 19.07.2009 um 15:12:49 Uhr
Goto Top
Oh sorry. Excel 2007 und ich will das als Makro machen. Also VBA.
Berrnd
Berrnd 19.07.2009 um 20:42:05 Uhr
Goto Top
Hi,

hier mal ein kleines VBA Beispiel:

'Also hier gehts weiter nachdem die Auswahl selektiert wurde  
Selection.Copy
Sheets("Name des Ziel Datenblattes").Select  
Range("A2").Select  
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Vielleicht hilfts Dir ja weiter.

Viele Grüße
Bernd
76109
76109 20.07.2009 um 00:04:01 Uhr
Goto Top
Hallo Schnufflchen!

Das sollte funktionieren:
Option Explicit
Option Compare Text

Sub Test()
    Dim Wks1 As Worksheet, Wks2 As Worksheet, Found As Range, c As Range
    
    Set Wks1 = Sheets("Tabelle1"):  Set Wks2 = Sheets("Tabelle2")  
    
    Application.ScreenUpdating = False
    
    With Wks1
        For Each c In .Range("F2:F" & .Cells(.Rows.Count, "F").End(xlUp).Row)  
            If  Not IsEmpty(c) Then
                Set Found = Wks2.Columns("A").Find(c, LookIn:=xlValues, LookAt:=xlWhole)  
                If Not Found Is Nothing Then
                    .Rows(c.Row).Copy:  Wks2.Rows(Found.Row + 1).Insert Shift:=xlDown
                End If
            End If
        Next
    End With
    
    Application.CutCopyMode = False:  Application.ScreenUpdating = True
End Sub

Gruß Dieter
Schnufflchen
Schnufflchen 20.07.2009 um 09:47:19 Uhr
Goto Top
Woohoooo, es geht und genauso, wie ich es mir vorgestellt habe. Grandios! Das erspart mir monatlich einige Stunden Arbeit! Dankeschön!
Eine klitzekleine Frage hab ich aber noch. Ist es möglich, mir noch genau zu erklären, was jede Zeile genau macht, damit ich den AUfbau verstehe und zukünftig ein paar Sachen besser im Alleingang hinbekomme?
76109
76109 20.07.2009 um 10:20:20 Uhr
Goto Top
Hallo Schnufflchen!

Na, dann erkläre ich mal face-smile
Option Explicit
'Hiermit wird verlangt, dass alle benutzten Variablen definiert werden.  

Option Compare Text
'Hiermit wird festgelegt, dass bei Vergleichs-Operationen (Like, Find...)   
'NICHT zwischen Groß/Klein-Schreibung unterschieden wird.   

Sub Test()
    Dim Wks1 As Worksheet, Wks2 As Worksheet, Found As Range, c As Range
    
    Set Wks1 = Sheets("Tabelle1"):  Set Wks2 = Sheets("Tabelle2")  
   'Bei Abläufen in verschiedenen Tabs empfielt es sich, die Tabellenblätter explizit  
   'einer Variablen zuzuordnen und diese darüber anzusprechen.   
    
    Application.ScreenUpdating = False
   'Deaktiviert die Bildschirmaktualisierung während der Makro-Ausführung.  
   'Das Makro wird schneller ausgeführt und der Bildschirm flackert nicht.   
    
    With Wks1
       'Alle nachfolgenden Anweisungen, die mit einem Punkt beginnen, sind dem  
      'Tabellenblatt Wks1 zuzuordnen.    

        For Each c In .Range("F2:F" & .Cells(.Rows.Count, "F").End(xlUp).Row)  
       'c steht für jede einzelne Zelle im Bereich F2:F & Letzte Zeile mit Inhalt in Spalte F  

            If  Not IsEmpty(c) Then  'Keine leere Zellen  
                Set Found = Wks2.Columns("A").Find(c, LookIn:=xlValues, LookAt:=xlWhole)  
               'Found ist Zelle, in der der Wert gefunden wurde (xlWohle vergleicht ganzen Zellinhalt)    

                If Not Found Is Nothing Then  'Wenn gefunden dann  
 
                    .Rows(c.Row).Copy:  Wks2.Rows(Found.Row + 1).Insert Shift:=xlDown
                    'Zeile mit Suchwert kopieren und in einer neuen Zeile gefunden +1 einfügen  
                End If
            End If
        Next
    End With
    
    Application.CutCopyMode = False:  Application.ScreenUpdating = True
   'Die Kopiermarkierung aufheben und die Bildschirmaktualisierung wieder aktivieren  

End Sub

Gruß Dieter
Schnufflchen
Schnufflchen 20.07.2009 um 14:54:46 Uhr
Goto Top
Aaah, jetzt ist das auch für mich lesbar face-wink
Angenommen ich wollte die Zeile aus Tabellenblatt1 erst ab der Spalte F reinkopieren, dann müsste ich einfach die Zeile 32 zu:

wks2.Range(Cells((Found+1),6).insert shift:=xlDown

umändern? Das sind jetzt nur Spielereien, so lern ich das halt immer am besten =)
76109
76109 20.07.2009 um 16:01:29 Uhr
Goto Top
Hallo Schnufflchen!

So einfach geht das nichtface-smile

Werte aus Tab1 von Spalte A-F in Tab2 in neue Zeile Spalte F-K in etwa so:
If Not Found Is Nothing Then
   Wks2.Rows(Found.Row + 1).Insert Shift:=xlDown 'Neue Zeile in Tab2 einfügen  
  .Range(c.Offset(0, -5), c.Offset(0, 0)).Copy Destination:=Wks2.Cells(Found.Row + 1, 6)
   Oder
  .Range(c.Offset(0, -5), c).Copy Destination:=Wks2.Cells(Found.Row + 1, 6)
  'In Tab1 Spalte A-F nach Tab2 in neue Zeile Spalte F-K kopieren   
End If
Oder in Tab2 gleiche Zeile Spalte B-G:
If Not Found Is Nothing Then
  .Range(c.Offset(0, -5), c.Offset(0, 0)).Copy Destination:=Wks2.Cells(Found.Row , 2)
   Oder
  .Range(c.Offset(0, -5), c).Copy Destination:=Wks2.Cells(Found.Row , 2)
  'In Tab1 Spalte A-F nach Tab2 gleiche Zeile Spalte B-G kopieren   
End If

Gruß Dieter
Jensson
Jensson 11.08.2014 um 14:26:18 Uhr
Goto Top
Hallo face-smile
Ich weis der Thread ist schon etwas alt, aber ich da trotzdem mal ´ne Frage: (Excel 2010)

ich will, dass Werte aus Spalte B (ab B2 bis letzte beschriebene) in ein 2. Tabellenblatt in Spalte E kopieren. Dafür habe ich dein Skript etwas an die Gegebenheiten angepasst, jedoch passiert beim Starten des Makros genau gar nichts :/ Ich bin Einsteiger in VBA/Programmieren allgemein und finde deswegen auch keinen Fehler. Kannst du mir helfen?


Option Compare Text
Option Explicit

Sub KopierenAdm()
Dim T1 As Worksheet, T2 As Worksheet, Found As Range, c As Range

Set T1 = Sheets("Tabelle1"): Set T2 = Sheets("Tabelle2")

Application.ScreenUpdating = False

With T1
For Each c In .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
If Not IsEmpty(c) Then
Set Found = T2.Columns("E").Find(c, LookIn:=xlValues, LookAt:=xlWhole)
If Not Found Is Nothing Then
.Rows(c.Row).Copy: T2.Rows(Found.Row + 1).Insert Shift:=xlDown
End If
End If
Next
End With

Application.CutCopyMode = False: Application.ScreenUpdating = True
End Sub


Vielen Dank im Vorraus face-smile