Wenn bestimmter Text, dann Zeile kopieren in Blatt

[MyHello]

Hallo an alle, ich habe bisher immer nur die Grundfunktionen von Excel genutzt... 

Ich möchte nun aber ein Excel-Dokument für alle Kollegen erstellen und zwar mit folgender Funktion: 
In einer Spalte sollen Namen der Kolleginnen eingetragen werden können und wenn ein bestimmter Name in eine Zelle eingetragen wird, sollte diese ganze Zeile in eine anderes Blatt oder Excel-Dokument automatisch kopiert werden. 

Falls jemand eine Idee hat wie man das hinbekommt, bitte gerne! Vlt. mit Makros?

Liebe Grüße

[shift-del]

Moin

1. Total überflüssig. Zumindest ohne weitere Hintergründe.
2. https://learn.microsoft.com/en-us/office...range.copy

[Gast 123]

Hallo

O Gott im Himmel, das darf doch NICHT WAHR sein!!   Ich fasse es nicht!!   Träume ich da???

Wir predigen im Forum allen Fragern man solle im Code bei Copy auf Sheet.Select verzichten, 
und in einem Offiziellen Beispiel von MS selbst finde ich einen Code mit Sheet und Range.Select direkt im Dutzend!!
Da bin ich einfach sprachlos, liebe Kollegen!!    (Der steht unter dem unten angegebenen Beispiel!)

Bei diesem Beispiel, was davor steht, fehlt bei externen Dateien noch die Angabe der Quell- und Zielmappe.
Und in der Zielmappe muss man vorher bitte wissen in welche Zeile kopiert werden soll??
Eine Anfrage ohne Beispieldatei zu beantworten ist somit reines Ratespiel.

Code:

Worksheets("Sheet1").Range("A1:D4").Copy _
    destination:=Worksheets("Sheet2").Range("E5:H8")

mfg Gast 123

[RPP63]

Moin!
Ja, der Code im MS-Beispiel ist unfassbar dämlich!
Da hat es mich gleich mal gejuckt.

Voraussetzung: Leere Arbeitsmappe mit 3 Blättern.
Zunächst mal konstruieren wir eine Ausgangsbasis, die auch mit der Uralt-Version von Gast123 lauffähig ist.
Spalte A wechselweise A und B, Spalten B bis D Adresse in Z1S1-Schreibweise.

Sub Konstruktion()
With Tabelle1
  .Range("A1:D1") = Split("Wahl SpB SpC SpD")
  .Range("A2:A1001").Formula = "=CHAR(65+MOD(ROW(),2))"
  .Range("B2:D1001").Formula = "=ADDRESS(ROW(),COLUMN(),4,0)"
  With .Cells(1).CurrentRegion
    .Copy
    .PasteSpecial xlPasteValues
  End With
  Application.CutCopyMode = False
End With
End Sub

Jetzt messen wir mal die Laufzeit des unsäglichen MS-Beispiels:

Public Sub CopyRows()
    Start = Timer
    Tabelle1.Select
    ' Find the last row of data 
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    ' Loop through each row 
    For x = 2 To FinalRow
        ' Decide if to copy based on column D 
        ThisValue = Cells(x, 1).Value
        If ThisValue = "A" Then
            Cells(x, 1).Resize(1, 4).Copy
            Tabelle2.Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Tabelle1.Select
        ElseIf ThisValue = "B" Then
            Cells(x, 1).Resize(1, 4).Copy
            Tabelle3.Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Tabelle1.Select
        End If
    Next x
    Debug.Print "MS: " & Timer - Start
End Sub

Ergebnis (neben unsäglichen Kopfschmerzen wegen des Bildschirmflimmerns):
MS: 73,67969

Jetzt mal ein Code, wie man es richtig macht:

Sub Schnell()
Dim Start#, i&
Start = Timer
With Tabelle1.Cells(1).CurrentRegion
  .AutoFilter 1, "A"
  .Copy Tabelle2.Cells(1)
  .AutoFilter 1, "B"
  .Copy Tabelle3.Cells(1)
  .AutoFilter
End With
Debug.Print "Filter: " & Timer - Start
End Sub

Ergebnis:
Filter: 0,083984375
 
Meine Variante ist 877-mal schneller …

[MyHello]

Danke

[snb]

Code:

Sub M_snb()
  [A1:D1001] = [if(row(1:1001)=1,choose(column(A:D),"Wahl","SpB","SpC","SpD"),if(column(A:D)=1,char(65+mod(row(1:1001),2)),address(row(1:1001),column(A:D),4,0)))]
End Sub