Daten aus Tabelle in neues Tabellenblatt kopieren

tegatana · 13. November 2019 um 07:04

Ich habe folgendes Problem und bin leider nicht in der Lage dieses alleine zu lösen.

Ich habe eine Tabelle mit folgendem Aufbau

In dieser Tabelle stehen Schülerdaten. Ich suche nach VBA-Code, der jetzt alle Schüler einer Klasse in ein neues Tabellenblatt kopiert und dieses Tabellenblatt mit der Klassenbezeichnung versieht. Die Überschriften aus der Ursprungstabelle sollen dabei übernommen werden.

Das Ergebnis wären also etwa 50 Klassen mit den jeweilig zugeordneten Schülern.

Geht so etwas?

Ich habe bisher nur folgendes hinbekommen:

Option Explicit
Public Sub TabelleNeu()
Dim klasse As String
ActiveWorkbook.Worksheets.Add After:=Sheets(Sheets.Count)
klasse = InputBox(„Welche Klasse?“, „Export“)
ActiveSheet.Name = klasse
ActiveSheet.Range(„A1“).Value = klasse
ActiveSheet.Range(„A2“).Value = „Nutzername“
ActiveSheet.Range(„B2“).Value = „Paßwort“
ActiveSheet.Range(„C2“).Value = „Nachname“
ActiveSheet.Range(„D2“).Value = „Vorname“
ActiveSheet.Range(„A3“).Select
ActiveSheet.Range(„A3“).paste
End Sub

Ich habe also in der Ursprungsdatei die Daten zu einer Klasse markiert, bin dann per Button auf das Makro gegangen, habe den Klassennamen eingegeben und dann die Fehlermeldung bekommen „Objekt unterstützt diese Eigenschaft oder Methode nicht“

Es sieht also noch nicht so aus, als ob ich das hinbekomme.

Peter_David_McWilliams · 13. November 2019 um 07:04

versuche:

Option Explicit

Private mWSneu As Worksheet ’ Modul Variabel, wird in TabelleNeu gesetzt
Private miZeile As Long

Private Sub Kopiere(ByVal psKlasse As String)
Dim lWS As Worksheet
Dim liAnzahl As Long
Dim i As Long
Set lWS = ActiveWorkbook.Worksheets(psKlasse)
liAnzahl = lWS.UsedRange.Rows.Count

For i = 1 To liAnzahl
miZeile = miZeile + 1
mWSneu.Range(„A“ & miZeile).Value = lWS.Range(„A“ & i).Value
mWSneu.Range(„B“ & miZeile).Value = lWS.Range(„B“ & i).Value
mWSneu.Range(„C“ & miZeile).Value = lWS.Range(„C“ & i).Value
mWSneu.Range(„D“ & miZeile).Value = lWS.Range(„D“ & i).Value
mWSneu.Range(„E“ & miZeile).Value = lWS.Range(„E“ & i).Value
mWSneu.Range(„F“ & miZeile).Value = psKlasse
Next i
End Sub

Public Sub TabelleNeu()
Set mWSneu = ActiveWorkbook.Worksheets.Add(After:=Sheets(Sheets.Count))
miZeile = 1

With mWSneu
.Range(„A“ & miZeile).Value = „Nutzername“
.Range(„B“ & miZeile).Value = „Paßwort“
.Range(„C“ & miZeile).Value = „Nachname“
.Range(„D“ & miZeile).Value = „Vorname“
.Range(„E“ & miZeile).Value = „Nr“
.Range(„F“ & miZeile).Value = „Klasse“
End With

Call Kopiere(„Klasse1“) ’ fuer jede Klasse ein Aufruf !!
Call Kopiere(„Klasse2“) ’ ---------------------------
’ …
Call Kopiere(„Klasse999“)
Call MsgBox(miZeile & " Zeilen kopiert!")
End Sub

Rainer_Engelhardt_ad43bf · 13. November 2019 um 07:04

Hallo, ich versuche mal zu helfen, auch wenn ich das Problem nicht ganz verstehe: es sollen wohl aus einer Sammeldatei Daten mit einem bestimmten Kriterium in eine neue Tabelle übernommen werden? Ich würde die Daten innerhalb des Makros selektieren und übertragen.
Man kann jede Zelle mit Sheets(name oder nummer).Cells(row,col) einzeln lesend und schreibend adressieren (im Prinzip auch noch mit Workbook(…)) qualifizieren oder mit Copy/Paste übertragen.

aus Sicherheitsgründen eine evtl. bestehende Tabelle klasse löschen und den Fehler ignorieren
Tabelle wie codiert einrichten
die Überschriftszeile der Quelltabelle übertragen
Schleife über alle Einträge der Quelldatei, wenn ein Eintrag mit dem Suchkriterium übereinstimmt Zeile übertragen (Zeilennummer in beiden Tabellen getrennt hochzählen!).
Hinweis:
Am einfachsten macht man das mit einem Mittschnit und ändert den dann etwas ab (aus Rows(„1:1“) habe ich Rows(row_1) gemacht, also eine Variable eingesetzt.
modifizierter Mitschnitt:
Sheets(„Bestand“).Select
Rows(row_1).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(klasse).Select
Rows(row_2).Select
ActiveSheet.Paste
Viel Erfolg
Rainer

OVMueller · 13. November 2019 um 07:04

Hallo Tegatana,

Ich habe leider gerade kein Excel installiert. Aber du kannst mal folgendes versuchen. habe es nicht getestet. also musst du bei auftretenden fehlern, entweder selbst mal versuchen, oder einfach noch mal schreiben.

lg OVM

sub sortieren()

dim sourcesheet as worksheet
set sourcesheet = sheets(1) ’ sofern das tabellenblatt die 1 ist
dim c as integer
dim klassenspalte as integer
dim a as integer
dim vorhanden as boolean

klassenspalte = 6 ’ (bei bedarf ändern)

for c = 1 to 500 'Hier die Zeilen von - bis eingeben (bsp erster schüler zeile 1, letzter 50)
vorhanden = false
for a = 1 to sheets.count
if sourcesheet.cells(c, klassenspalte).value = sheets(a).name then
vorhanden = true
end if
next a

if vorhanden = true then
sourcesheet.row©.copy
sheets(sourcesheet.cells(c, klassenspalte).value).cells(1000,1).end(xlup).select
activecell.paste
else
sheets.add name:=sourcesheet.cells(c, klassenspalte).value
sourcesheet.row©.copy
sheets(sourcesheet.cells(c, klassenspalte).value).cells(1000,1).end(xlup).select
activecell.paste
end if

next c

end sub

Erich_Gier · 13. November 2019 um 07:04

Rückfragen nötig
Hallo tegatana (?),
aus deiner Aufgabenstellung werde ich nicht so recht schlau.

Du schreibst:
„VBA-Code, der jetzt alle Schüler einer Klasse in ein neues Tabellenblatt kopiert“
Wie erkennt das Makro „alle Schüler einer Klasse“? Steht die Klasse in Spalte F des Quellblatts?

Weiter unten schreibst du:
„habe also in der Ursprungsdatei die Daten zu einer Klasse markiert“
Das könnte bedeuten, dass alle markierten Schüler kopiert werden sollen - unabhängig von Spalte F.
Ist das so? Spielt die Klasse in Spalte F keine Rolle?

Was genau hast du markiert, wenn du „markierten Schüler“ schreibst? Ganze Zeilen?

Du schreibst:
„Die Überschriften aus der Ursprungstabelle sollen dabei übernommen werden.“
Wo auf dem Quellblatt stehen die Überschriften, die übernommen werden sollen?
In deinem Makro wird nichts übernommen, da werden die Überschriften neu geschrieben.

Kannst du die Aufgabe etwas genauer und konkreter beschreiben?

Warum stellst du deine Frage eigentlich nicht im w-w-w-Forum zur Tabellenkalkulation?
Dann könnten viele antworten, du wärest nicht von einem Antworter abhängig.

Grüße von Erich aus Kamp-Lintfort

HChristian · 13. November 2019 um 07:04

Hallo tegatana,

ich würde diesen Code nehmen:

Private Sub CommandButton1_Click()
TabelleNeu
End Sub

Public Sub TabelleNeu()

Dim Klasse As String
Dim i As Long
Dim a As Long
Dim lleZeile As Long
Klasse = InputBox(„Welche Klasse?“, „Export“)
For i = 1 To Worksheets.Count 'Überprüfung ob Tabelle schon vorhanden
If Worksheets(i).Name = Klasse Then
MsgBox „Klasse existiert bereits!“
Exit Sub
End If
Next i
'neues Blatt anlegen
ActiveWorkbook.Worksheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = Klasse
ActiveSheet.Range(„A1“).Value = Klasse
With Worksheets(„Alle“) 'mit der GesamtschülerTabelle
'Überschriften kopieren
.Cells(1, 1).EntireRow.Copy Worksheets(Klasse).Cells(2, 1).EntireRow
'letzte Zeile finden
lleZeile = .Cells(Rows.Count, 1).End(xlUp).Row
a = 1
For i = 1 To lleZeile
If .Cells(i, 6).Value = Klasse Then 'Zeile nach Klasse prüfen
.Cells(i, 1).EntireRow.Copy Worksheets(Klasse).Cells(2 + a, 1).EntireRow
a = a + 1
End If
Next i
End With
MsgBox „Daten kopiert“
End Sub

Ich habe vorausgesetzt das die Überschriften in der Tabelle „Alle“ in der ersten Zeile stehen.
Die Klasse steht in Spalte F.

Ich hoffe du kommst damit zurecht.

Gruß

Christian

tegatana · 13. November 2019 um 07:04

if vorhanden = true then
sourcesheet.row©.copy
sheets(sourcesheet.cells(c,
klassenspalte).value).cells(1000,1).end(xlup).select
activecell.paste

Erst enmal vielen Dank. Ich bin mit den Funktionen hier im Board etwas überfordert. Da werde ich mich wohl auch noch einarbeiten müssen. Leider ist meine Zeit im Augenblick etwas knapp.
Ich habe deinen Code ausprobiert , bekommen jedoch immer eine Fehlermeldung bei sourcesheet.row©. --> „Methoden oder Datenobjekt nicht gefunden“

Kannst Du damit etwas anfangen?

Gruß tegatana

tegatana · 13. November 2019 um 07:04

Erst enmal vielen Dank. Ich bin mit den Funktionen hier im Board etwas überfordert. Da werde ich mich wohl auch noch einarbeiten müssen. Leider ist meine Zeit im Augenblick etwas knapp.
Ich werde versuchen, das Thema noch einmal in einem öffentlichen board zu schreiben.

Gruß tegatana

tegatana · 13. November 2019 um 07:04

Erst enmal vielen Dank. Ich bin mit den Funktionen hier im Board etwas überfordert. Da werde ich mich wohl auch noch einarbeiten müssen. Leider ist meine Zeit im Augenblick etwas knapp.
Ich werde versuchen, das Thema noch einmal in einem öffentlichen board zu schreiben.

Gruß tegatana.

Rainer_Engelhardt_ad43bf · 13. November 2019 um 07:04

Hallo, vielen Dank für die Rückmeldung - eine der ganz, ganz wenigen!
Mir scheint, dass die Aufgabenstellung nicht ganz klar ist, was sind denn die Aufgaben der extrahierten Tabellen? Wenn das Layout überall gleich ist hilft u.U. das Filtern: gesamte Tabelle markieren, dann im Menu Daten->Filter-AutoFilter anclicken, es erscheinen in den belegten Spalten Drop-/Down-Symbole. In der entsprechenden Spalte den Wert (Klasse) auswählen, schon siehst Du nur noch die gewünschten Werte.
Viel Erfolg
Rainer

OVMueller · 13. November 2019 um 07:04

Dann probier mal

Liebe grüße

kivelobs · 13. November 2019 um 07:04

Hallo,

leider habe ich es nicht geschafft früher zu antworten. Ich verstehe das Problem leider nicht ganz. Wenn möglich sende doch mal die Datei mit code an [email protected],

Gruß