Office: Wenn Bedingung erfüllt, dann mehrere Zellen in neues Registerblatt einfügen

Hallo,

gleich mal vorneweg: Ich bin leider absoluter Neuling was Makros und VBA betrifft.

Ich habe zwei Registerblätter (das erste "TN Übersicht", das zweite "Teilnehmerliste"). Jetzt soll Folgendes geschehen: Wenn in Spalte "EU" des ersten Registerblattes der Wert "1" vorkommt, dann sollen die Inhalte der Spalten "A", "B", und "L" des ersten Registerblattes in das zweite Registerblatt in die Spalten "B", "C" und "D" kopiert werden. Dabei soll im Registerblatt 2 erst bei Zeile 16 begonnen werden.

Ich habe schon VBA geöffnet und nachdem ich im Internet gegoogelt habe, versucht eine dort gefundene Formel auf mein Problem zu übertragen:

Private Sub Worksheet_Activate()
Dim a As Long, i As Long
Application.ScreenUpdating = False
a = 1
For i = 1 To 1000
With Worksheets("Teilnehmerliste")
If .Cells(i, "EU") = "1" Then
Worksheets("TN Übersicht").Cells(i, "A").Value = Worksheets("Teilnehmerliste").Cells(i, "B").Value
Worksheets("TN Übersicht").Cells(i, "B").Value = Worksheets("Teilnehmerliste").Cells(i, "C").Value
Worksheets("TN Übersicht").Cells(i, "L").Value = Worksheets("Teilnehmerliste").Cells(i, "D").Value
a = 16 + 1
Else
End If
End With
Next i
Application.ScreenUpdating = True
End Sub

Wenn ich diesen Code jetzt in VBA eingegeben habe und dann VBA schließe und dann in das zweite Registerblatt gehe, das Makro auswähle und auf "Ausführen" klicke, passiert rein gar nichts.

Hat jemand von euch einen Rat, was an der Formel oder meiner Vorgehensweise nicht passt? Für jegliche Tipps wäre ich sehr dankbar. Vielen Dank.

 

Hallo,

das nachfolgende VBA-Makro musst Du unbedingt im Codemodul des Arbeitsblattes "Teilnehmerliste" speichern:
1) einen Rechtsklick mit der Maus auf den Tabellenreiter des Arbeitsblattes "Teilnehmerliste" ausführen
2) aus der dann erscheinenden Liste den Befehl "Code anzeigen" auswählen
3) dadurch wird das Codemodulfenster vom Arbeitsblatt "Teilnehmerliste" angezeigt: in dieses den nachfolgenden VBA-Code mittels Kopieren/Einfügen einfügen.

Code:

Option Explicit
'
'1.Arbeitsblatt "TN Übersicht"    : Quellblatt beim Kopieren (falls Spalte "EU" = 1): von Spalte  A, B, L
'2.Arbeitsblatt "Teilnehmerliste" : Zielblatt  beim Kopieren (ab Zeile 16)          : nach Spalte B, C, D
'
'Dieses Makro muss im Codemodul eines ARBEITSBLATTES gespeichert werden,
'denn es ist dafür konzipiert, auf das Activate-Ereignis eines Arbeitsblattes zu reagieren.
'
'Vermutlich ist am besten, es im Codemodul des Arbeitsblattes "Teilnehmerliste" zu speichern:
'denn dann wird, sobald man in dieses Arbeitsblatt umschaltet (=das Arb.blatt aktiviert),
'dieses Makro automatisch ausgelöst und die Aktualisierungen seines Inhaltes anhand
'von Arbeitsblatt "TN Übersicht" durchgeführt.
'
Private Sub Worksheet_Activate()

  Dim wsZiel As Worksheet, wsQuelle As Worksheet
  Dim a As Long
  Dim Zeile As Long, lztZeileQuelle As Long
  
  Application.ScreenUpdating = False
  
  Set wsQuelle = Worksheets("TN Übersicht")
  Set wsZiel = Worksheets("Teilnehmerliste")
  
  With wsQuelle.UsedRange
    'Letzte Zeilen-Nr. des benutzten Bereiches im Quellarbeitsblatt
    lztZeileQuelle = .Row + .Rows.Count - 1
  End With
  
  a = 15
  For Zeile = 1 To lztZeileQuelle
    With wsQuelle
      If .Cells(Zeile, "EU").Value = "1" Then
        wsZiel.Cells(Zeile + a, "B").Value = .Cells(Zeile, "A").Value
        wsZiel.Cells(Zeile + a, "C").Value = .Cells(Zeile, "B").Value
        wsZiel.Cells(Zeile + a, "D").Value = .Cells(Zeile, "L").Value
      End If
    End With
  Next Zeile
  
  Application.ScreenUpdating = True
End Sub

Dieses Makro reagiert nämlich aufgrund seines Namens "Worksheet_Activate()" auf ein Arbeitsblatt-Aktivierungsereignis, d.h. schaltet man mit der Tastatur oder mit der Maus in das Arbeitsblatt um, in dessen Codemodul sich dieses Makro befindet, so wird es in diesem Moment automatisch ausgeführt.
Ein händisches Ausführen dieses Makros erübrigt sich damit. Dieses ist ohnehin nicht möglich, da es als "Private" deklariert ist (ich weiß nicht, was Du da getan haben willst, um es händisch auszuführen??)

Anmerkung:
Was die Abfrage des Wertes in Spalte "EU" betrifft: Ich habe diese so programmiert, wie es in Deinem Vorgabemakro enthalten war, nämlich als Test, ob in der Spalte "EU" die Zeichenkette "1" enthalten ist. Sollte dort in Wahrheit die Zahl 1 stehen und diese abgefragt werden, dann müsste die "IF-Zeile" wie folgt lauten:
If .Cells(Zeile, "EU").Value = 1 Then

 

Hallo,

erstmal vielen Dank. Ich habe mal geschaut und die Spalten in der Quellregisterkarte sind als "Zahl" formatiert. Somit habe ich deine untere Formel eingefügt und bin dann so vorgegangen, wie von dir beschrieben (grüner Text rausgelöscht und deine Arbeitsanweisung befolgt). Nur leider tut sich rein gar nichts.

Ich habe mal nachgeschaut:
- die Namen der Registerblätter stimmen
- die Zellnamen sind ebenso korrekt
- die "EU-Spalte" in der Quelldatei ist auf "Zahl" gestellt -> deine untere "IF-Zeile" habe ich eingefügt

Wäre toll, wenn du mir noch weiter helfen könntest. Dankeschön :)

 

Hallo,

das hört sich so an, als ob Du entweder die Makros wieder automatisch aus der Datei entfernt hättest oder aber die zwar existierenden Makros nicht aktiviert hättest. - Was in beiden Fällen darauf hinausläuft, dass sich nichts tut.

Ich nehme an, dass Deine Excel-Version Excel2007/Excel2010/Excel2013 ist.
1) Dann musst Du unbedingt nach dem Import des Makros die Excel-Datei als "*.xlsm"-Datei speichern (bzw. im alten "*.xls"-Format), aber keinesfalls im "*.xlsx"-Format. Im "*.xlsx"-Format werden sämtliche Makros beim Speichern der Datei entfernt - vor dem Speichervorgang wird eine Warnmeldung eingeblendet, dass vorhandene Makros verlorengehen.
2) Oder aber Du hast in den Excel-Optionen das Ausführen vom Makros prinzipiell deaktiviert.
3) Oder aber Du hast nach dem Laden der Excel-Datei die Aufforderung, geladene Makros zu aktivieren, ignoriert (gelbe Schaltfläche).

Die Anzahl der Registerkarten (Anzahl/Reihenfolge der Arbeitsblätter) hat darauf keinen Einfluss, sie werden im Makro ohnehin mit ihrem Namen "TN Übersicht" bzw. "Teilnehmerliste" angesprochen und nicht mit ihrer internen Indexnummer.

 

Wow, danke für die schnelle Rückmeldung.

Ich habe Excel 2010.

1) Das habe ich schon gemerkt, als ich mit Makros am "Herumexperimentieren" war :-). Die Datei ist allerdings schon längst als .xlsm-Datei abgespeichert. Daran sollte es also nicht liegen.

2) In den Excel-Optionen habe ich die Makros auch schon aktiviert.

3) Eine gelbe Schaltfläche habe ich nach dem Speichern und Schließen der Datei und dem erneuten Öffen nicht gehabt.

Ich habe vor ein paar Tagen schon einmal einen Code aus dem Internet angepasst, bei dem ich die kompletten Zeilen kopieren lies. Der ging seltsamerweise. Aber das ist ja leider nicht das, was ich möchte. Ich schau mal, ob ich diesen Code noch finde, dann poste ich ihn mal.

Edit:
Folgenden Code habe ich ausprobiert und er führt zumindest schon einmal dazu, dass die kompletten Zeilen ins neue Tabellenblatt übertragen werden:


Public Sub Zeilen_kopieren()
a = 16
Application.ScreenUpdating = False
For i = 16 To 100

If Sheets("TN Übersicht").Cells(i, "EU").Value = 1 Then
Sheets("TN Übersicht").Select
Rows(i).Copy
Sheets("Teilnehmerliste").Select
Rows(a).Select
ActiveSheet.Paste
a = a + 1
End If

Next i
Application.ScreenUpdating = True
End Sub

 

Mir ist gerade etwas aufgefallen: Mit deiner Variante werden mir die Inhalte der drei Spalten in der Ursprungstabelle (A = Nachname, B = Name und L = Institut) bei dem Eintrag "1" in Spalte "EU" gelöscht. In der Quelltabelle erscheint allerdings nichts.

Was ist da jetzt das Problem? Und wie erreiche ich, dass die Spalten A, B und L in der Ursprungstabelle ihre Inhalte behalten? Ich möchte nämlich lediglich diese drei Spalten in die andere Tabelle kopiert bekommen.

Danke schonmal im Voraus, dass du so geduldig mir hilfst.


Edit: Habe mal wieder ein bisschen rumgebastelt:

Option Explicit
Public Sub Zellen_kopieren()
Dim wsZiel As Worksheet, wsQuelle As Worksheet
Dim a As Long
Dim Zeile As Long

Set wsQuelle = Sheets("TN Übersicht")
Set wsZiel = Sheets("Teilnehmerliste")

a = 16
Application.ScreenUpdating = False
For Zeile = 16 To 1000

If wsQuelle.Cells(Zeile, "EU").Value = 1 Then
wsQuelle.Select
Cells(Zeile, "A").Copy
wsZiel.Select
Cells(Zeile + a, "B").Select
ActiveSheet.Paste
wsQuelle.Select
Cells(Zeile, "B").Copy
wsZiel.Select
Cells(Zeile + a, "C").Select
ActiveSheet.Paste
wsQuelle.Select
Cells(Zeile, "L").Copy
wsZiel.Select
Cells(Zeile + a, "D").Select
ActiveSheet.Paste
a = a + 1
End If

Next Zeile

Application.ScreenUpdating = True
End Sub

Hiermit kopiert er mir einwandfrei die gewünschten Informationen in das neue Tabellenblatt. Nur wie bekomme ich jetzt die ganzen leeren Zeilen dazwischen raus? Und wenn wir gleich dabei sind: Ist es möglich,
1. die Namen (= Spalte B) gleich alphabetisch aufsteigend sortieren zu lassen?
2. in Spalte A automatisch eine Zahl beginnend ab 1 (ab Reihe 16) einfügen zu lassen?
3. um alle Inhalte beginnend ab Zeile 15 (A15-F15) bis runter zu (Axy-Fxy) (xy = die letzte Zeile, die gefüllt ist) ein komplettes Gitternetz ziehen zu lassen?

Ich würde nämlich gerne ausgehend von der Quelldatei eine fertige Teilnehmerliste in der Zieldatei haben.