Benötige VBA Experten Hilfe

Hallo zusammen
ich wäre sehr froh um Ihre Hilfe für meine untenstehende Problemstellung. Ich komme leider nicht weiter.
Besten Dank im voraus.
Mit freundlichen Grüssen
Michel
Ausgangslage: Arbeitsmappe mit 3 Tabellen
Tabelle1: "AB_Rück_kurs_D" beinhaltet eine Liste mit Klassen-Nr (zB. 104), Schulname, Kursname, und Werte
in %, diese Werte sind Klassen-Durschnitte (verschiedene Fächer)
Tabelle2: "AB_Ru¦êck_SS_DG" beinhaltet die Details jeder Klasse, z.B. Klassenr., Teilnehmer und Durchschnittswerte etc.
Spalte A definiert die Klasse-Nummer (z.B. 104, 203.....) Klasse-Nummer ist nicht chronologisch.
Die Klassenanzahl kann auch unterschiedlich sein.
Spalten B-I definiert Name, Vorname, Werte (u.s.w.) Anzahl der Teilnehmer unterscheidet sich ebenfalls (z.B. 13, 15, 12, 18...)
Das Makro sollte merken, wenn wieder eine neue Klasse-Nummer auf der Spalte A erscheint inklusive den dazugehörenden
Daten B bis I
Tabelle3: "AB_Klaru¦êck_DG" dient als Klassenrückmeldung und beinhaltet Texte, Klassen-Durchschnitte und
Klassen-Mittelwerte sowie Diagramm. Dies sollte nach Aktualisierung gespeichert werden unter den Klassen-Nr (Spalte A)
mit der Endung _ABDG (zB. 100_ABGD) anschliessend muss diese Tabelle jedes Mal in einen Ordner "Klassenrückmeldungen"
gespeichert werden.
Ich habe das untenstehende Makro mit dem Recorder angefangen, kann leider nicht fertig machen!
Die Probleme:
1) Das Makro sollte den zu den Klassen zugehörigen Bereich von Tabelle2 (in diesem Fall A2 - I14) individuell kopieren und in
A62 von der Tabelle3 einfügen.
2) Das Makro muss von Anfang an das Ganze wiederholen, bis die Liste "AB_Rück_Kurs_D" (Tabelle1) am Ende ist.


Sub Makro1()
Sheets("AB_Rück_kurs_D").Select
Range("C2:H2").Select
Selection.Copy
Range("J6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("D4").Select
Sheets("AB_Rück_kurs_D").Select
Range("K6:O10").Select
Selection.Copy
Sheets("AB_Klaru¦êck_DG").Select
Range("A20").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A2").Select
Sheets("AB_Ru¦êck_SS_DG").Select
Range("A2:I14").Select
Selection.Copy
Sheets("AB_Klaru¦êck_DG").Select
Range("A62").Select
ActiveSheet.Paste
Application.CutCopyMode = False ' komme leider nicht weiter!!
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo ypsilon
erstmals besten Dank, dass Du Dich gemeldet hast. Ich weiss, es ist wirklich komplex und ein sehr heikles Problem!
Bemerkung: Tabellen Namen sind ebenfals auch kompliziert gewählt, sorry! Könnten auch Tabelle1, Tablle, Tabelle3 heissen.
Das von mir geschilderte Makro müsste eigentlich (nur) noch in einen Ordner "Klassenrückmeldungen" als File gespeichert werden unter den Klassen-Nr (Spalte A)mit der Endung _ABDG. Makro sollte immer die Klassen Nr. übernehmen, Endung bleibt gleich (_ABDG).
Der Bereich "C2:H2" ("AB_Rück_kurs_D") entspricht den Daten der gesamten Klasse 104 (mit Durchnitt der Klasse).
Der Bereich "A2:I14" ("AB_Ru¦êck_SS_DG")entspricht den Details der Klasse 104 mit Schüler Name und deren individuellen Durchnitte.
Nach Speicherung der Daten von Klasse 104 als File unter dem Namen "104_ABDG", müsste das Makro automatisch die Daten der nächsten Klasse in der Zeile "C3:H3" ("AB_Rück_kurs_D") kopieren und auch in "J6" einfügen usw., dann in der Tabelle "AB_Ru¦êck_SS_DG" der nächste detaillierte Bereich (z.B. A15:I30) von der nächsten Klasse, z.B.Klasse 203 kopieren und in die Tabelle "AB_Klaru¦êck_DG" eingefügt werden und ebenfalls unter der Klasse Nr., in diesem Fall "203_ABDG" gespeichert werden. Das Makro sollte sich wiederholen bis der Bereich "C:H" ("AB_Rück_kurs_D") abgeschlossen ist (kann zum Beispiel A30:H30 sein).
Das heisst, wenn das Makro seinen Job gemacht hat, könnten im Ordner "Klassenrückmeldungen" z.B. 30 Files gespeichert sein (noch unbekannt).
Ich hoffe Du siehst klarer, und kannst mir helfen, das angefangene Makro zu vollenden, um dieses Problem zu lösen.
Besten Dank im voraus.
Mit freundlichen Grüssen
Michel

Sub uebertragen() Dim Zeile As Long Dim Zeile2 As Long Dim Zeile3 As Long Dim pfad As String Zeile = 2 Zeile2 = 2 Zeile3 = 62 pfad = "c:\temp\testing\" 'pfad eintragen Application.ScreenUpdating = False Sheets(3).Range(Cells(Zeile3, 1), Cells(Zeile3 + 100, 6)).ClearContents With Sheets(1) Do While .Cells(Zeile, 1) <> "" Sheets(3).Cells(6, 1) = .Cells(Zeile, 3) Sheets(3).Cells(6, 2) = .Cells(Zeile, 4) Do While Sheets(2).Cells(Zeile2, 1) = .Cells(Zeile, 1) For spalte = 4 To 9 Sheets(3).Cells(Zeile3, spalte - 3) = Sheets(2).Cells(Zeile2, spalte) Next spalte Zeile2 = Zeile2 + 1 Zeile3 = Zeile3 + 1 Loop With Sheets(3).Range(Cells(Zeile3, 1), Cells(Zeile3 + 100, 6)) .NumberFormat = "0.00%" .Font.ColorIndex = 55 End With Sheets(3).Copy ActiveWorkbook.SaveAs FileName:=pfad & Workbooks(1).Sheets(1).Cells(Zeile, 1) & "_ABDG.xls" ActiveWorkbook.Close Zeile3 = 62 Sheets(3).Range(Cells(Zeile3, 1), Cells(Zeile3 + 100, 6)).ClearContents Zeile = Zeile + 1 Loop End With Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread