AW: Tabellenblätter gruppieren
15.09.2014 13:48:51
fcs
Hallo Mehmet,
nachfolgend ein Makro zur Übertragung der Informationne ins Summenblatt.
Gruß
Franz
Public Sub Uebertrage_nach_SumList1()
Dim wksTail As Worksheet
Dim wksSL As Worksheet
Dim intSpa As Integer
Dim intZei As Integer
Dim ZeileSL As Long
Set wksSL = Worksheets("SumList")
wksSL.Range("a5:q500").ClearContents 'Bereich löschen
ZeileSL = 5
'Spaltentitel eintragen
intSpa = 2: wksSL.Cells(ZeileSL, intSpa) = "Art"
intSpa = 3: wksSL.Cells(ZeileSL, intSpa) = "Bericht"
intSpa = 4: wksSL.Cells(ZeileSL, intSpa) = "Kurs"
intSpa = 5: wksSL.Cells(ZeileSL, intSpa) = "'=="
intSpa = 6: wksSL.Cells(ZeileSL, intSpa) = "Vorname :"
intSpa = 7: wksSL.Cells(ZeileSL, intSpa) = "Zuname:"
intSpa = 8: wksSL.Cells(ZeileSL, intSpa) = "Geburtsname:"
intSpa = 9: wksSL.Cells(ZeileSL, intSpa) = "Familien Name:"
intSpa = 10: wksSL.Cells(ZeileSL, intSpa) = "Geb. Datum:"
intSpa = 11: wksSL.Cells(ZeileSL, intSpa) = "Kurs Abgeschlossen 1:"
intSpa = 12: wksSL.Cells(ZeileSL, intSpa) = "Kurs Abgeschlossen 2:"
intSpa = 13: wksSL.Cells(ZeileSL, intSpa) = "Kurs Abgeschlossen 3:"
intSpa = 14: wksSL.Cells(ZeileSL, intSpa) = "Kurs Abgeschlossen 4:"
intSpa = 15: wksSL.Cells(ZeileSL, intSpa) = "Kurs Abgeschlossen 5:"
intSpa = 16: wksSL.Cells(ZeileSL, intSpa) = "Vorkurse"
intSpa = 17: wksSL.Cells(ZeileSL, intSpa) = "Merkung"
For Each wksTail In ActiveWorkbook.Worksheets
Select Case wksTail.Name
Case "SumList"
'do nothing - dieses Blatt nicht auswerten
Case Else
With wksTail
For intZei = 7 To .Cells(.Rows.Count, 1).End(xlUp).Row
intSpa = 0
Select Case .Cells(intZei, 1)
Case "Vorname : "
ZeileSL = ZeileSL + 1
intSpa = 2: wksSL.Cells(ZeileSL, intSpa) = .Cells(1, 1)
intSpa = 3: wksSL.Cells(ZeileSL, intSpa) = .Cells(2, 1)
intSpa = 4: wksSL.Cells(ZeileSL, intSpa) = .Cells(5, 1)
intSpa = 5: wksSL.Cells(ZeileSL, intSpa) = "'=="
intSpa = 6
Case "Zuname:": intSpa = 7
Case "Geburtsname:": intSpa = 8
Case "Familien Name:": intSpa = 9
Case "Geb. Datum:": intSpa = 10
Case "Vorkurse:": intSpa = 16
Case "Bemerkung:": intSpa = 17
End Select
If intSpa > 0 Then
wksSL.Cells(ZeileSL, intSpa) = .Cells(intZei, 2)
End If
intSpa = 0
Select Case .Cells(intZei, 3)
Case "Kurs Abgeschlossen 1:": intSpa = 11
Case "Kurs Abgeschlossen 2:": intSpa = 12
Case "Kurs Abgeschlossen 3:": intSpa = 13
Case "Kurs Abgeschlossen 4:": intSpa = 14
Case "Kurs Abgeschlossen 5:": intSpa = 15
End Select
If intSpa > 0 Then
wksSL.Cells(ZeileSL, intSpa) = .Cells(intZei, 4)
End If
Next intZei
End With 'wksTail
End Select
Next wksTail
MsgBox "fertig"
End Sub