Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1920to1924
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Kopieren in verschiedene Tabellenblätter

Kopieren in verschiedene Tabellenblätter
27.02.2023 08:46:03
Ella
Hallo liebe Excel-Vollprofis,
ich beschäftige mich jetzt seit etwa einer Woche mit Excel VBA und dem Schreiben von Makros. Leider bin ich an meinen Grenzen angekommen, weil ich zwar den Code verstehen kann, aber scheinbar nicht gut genug selbst schreiben.
Ich habe folgendes Problem:
Bei mir im Betrieb haben wir eine Übersichtsexcel für alle Auszubildenden mit insgesamt 20 Spalten, wobei die letzte Spalte (T) immer angibt, ob der/die Auszubildende noch aktiv dabei ist. Kennzeichnen tun wir dies über ein "x" für "Erledigt/Ausgeschieden" und "-" für "Noch in der Ausbildung". Ich habe auch bereits eine bedingte Formatierung dahinter gelegt, sodass fertige Auszubildende farblich markiert und durchgestrichen werden, sobald in Spalte T das "x" eingetragen wird.
Diese Übersichten haben wir für die letzten 5 Jahre; jeweils ein Tabellenblatt für 2019, 2020, 2021, 2022 und eins für das aktuelle Jahr 2023 (Tabelle 3-7). Zusätzlich soll die Excel noch zwei weitere Tabellenblätter haben. Eins für alle aktiven Auszubildenden aus allen 5 Jahren (Tabelle1) und eins mit den bereits fertigen/ausgeschiedenen (Tabelle2).
Ziel ist also ein Makro zu haben, dass alle 5 Jahresübersichten abfragt (Tabelle 3-7) und von da aus Zeilen mit aktiven Auszubildenden ("-") in die Übersicht aller aktiven Azubis (Tabelle1) kopiert und Zeilen mit ausgeschiedenen Azubis ("x") in die Übersicht aller ausgeschiedenen Azubis (Tabelle2) kopiert.
https://www.herber.de/bbs/user/158031.xlsx (Das ist eine runtergebrochene Version unserer Übersicht. Spalte H ist hier der Marker um zu entscheiden, wo hin kopiert werden soll.)
Bisher habe ich einen Code gefunden, den ich so auf meine Bedürfnisse anpassen konnte, dass ich zwar die Zeilen in die zwei Übersichten kopiert habe, aber die dann mit den Daten der darauffolgenden Jahresübersicht überschrieben wurden.
Hier mein bisheriger Code:
Sub BedingteKopieZeilen()
Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Long
With Tabelle7
ZeileMax = .UsedRange.Rows.Count
n = 1
For Zeile = 2 To ZeileMax
If .Cells(Zeile, 20).Value = "x" Then
.Rows(Zeile).Copy Destination:=Tabelle2.Rows(n)
n = n + 1
If .Cells(Zeile, 20).Value = "-" Then
.Rows(Zeile).Copy Destination:=Tabelle1.Rows(n)
n = n + 1
End If
Next Zeile
End With
End Sub
Damit konnte ich unter Hinzufügen der gleichen Code-Struktur für die anderen Tabellenblätter zumindest den Kopiervorgang für alle Tabellen 3-7 durchführen, aber wie gesagt auf den Übersichten nur überschreiben. Ich habe auch Ideen an die Hand bekommen bzw. gefunden, die mein Problem lösen können (z.B. eine Schleife für die 5 Tabellen einfügen; eine weitere Variable einführen, um die vollen Zeilen in den Übersichten zu zählen, damit diese nicht überschrieben werden), aber ich bin aufgrund meiner geringen Erfahrung mit Excel im Allgemeinen und dem Schreiben von Makros einfach ein wenig überfordert mit dem Finden einer brauchbaren Lösung.
Ich hoffe, jemand von euch kann mir helfen!
Vielen Dank schon mal im Voraus :-)
Viele liebe Grüße
Ella

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren in verschiedene Tabellenblätter
27.02.2023 09:24:28
Rudi
Hallo,
teste mal:
Sub ella()
  Dim wksAkt As Worksheet, wksEnde As Worksheet
  Dim rngAkt As Range, rngEnde As Range, rngC As Range
  Dim i As Integer
  Set wksAkt = Worksheets("Aktuell alle")
  Set wksEnde = Worksheets("Ende Ausbildung")
  
  For i = 3 To Worksheets.Count
    Set rngAkt = Nothing
    Set rngEnde = Nothing
    
    With Worksheets(i)
      For Each rngC In .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
        Select Case rngC.Offset(, 7) 'H. Bei T: Offset(, 19)
          Case "x"
            If rngEnde Is Nothing Then
              Set rngEnde = rngC
            Else
              Set rngEnde = Union(rngEnde, rngC)
            End If
          Case Else
            If rngAkt Is Nothing Then
              Set rngAkt = rngC
            Else
              Set rngAkt = Union(rngAkt, rngC)
            End If
        End Select
      Next rngC
    End With
    
    If Not rngEnde Is Nothing Then
      rngEnde.EntireRow.Copy wksEnde.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    End If
     If Not rngAkt Is Nothing Then
      rngAkt.EntireRow.Copy wksAkt.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    End If
    
  Next i
          
End Sub
Gruß
Rudi
Anzeige
AW: Kopieren in verschiedene Tabellenblätter
27.02.2023 10:19:53
Ella
Hallo Rudi,
das hat einwandfrei funktioniert. Vielen, vielen Dank, dass hätte ich ohne deine Hilfe nicht geschafft!
Viele Grüße
Ella

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige