Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Mit VBA Zeilen in neue Register kopieren

Mit VBA Zeilen in neue Register kopieren
08.06.2009 12:29:49
Andreas
Ein Tabellenblatt soll nach einem bestimmten Kriterium durchsucht werden. Immer wenn das Suchkriterium gefunden wird, soll die Zeile kopiert und in ein neues Tabellenblatt eingefügt werden. Dies soll solange geschehen bis alle Zeilen durchsucht worden sind.
Im Detail soll dies wie folgt funktionieren:
In dem Register „PPL“ stehen alle benötigen Informationen zu den einzelnen Projekten. In Zeile 15 sind die Spalten als Spaltenkopf benannt. Ab Zeile 16 werden die Projekte mit den relevanten Daten eingetragen. Die Datei wird monatlich aktualisiert. Neu hinzukommende Projekte werden am Ende der Liste ergänzt. Abgeschlossene Projekte werden im Feld „AC“ mit der Bemerkung „erledigt“ versehen. Die jeweilige Zeile bleibt im Register „PPL“ erhalten.
Pro Mitarbeiter habe ich ein eigenes Register angelegt (MA 1 bis MA 5). Folgende Daten je Mitarbeiter sollen aus dem Register PPL in das Mitarbeiter Register automatisch übertragen werden, sofern im Feld AC „Bemerkung“ nicht „erledigt“ steht:
• Projektname (Register PPL, D15 wird Register z.B. MA 1, A1)
• Projekt-ID (Register PPL, C15 wird Register z.B. MA 1, A2)
• Phase (Register PPL, B15 wird Register z.B. MA 1, A3)
• ABCL (Register PPL, AB15 wird Register z.B. MA 1, A4)
• Start (Register PPL, U15 wird Register z.B. MA 1, A5)
• Dauer (Register PPL, V15 wird Register z.B. MA 1, A6); nur den Wert eintragen
Die Daten sollen jeweils ab der zweiten Zeile eingetragen werden. Hat z.B. ein Mitarbeiter 8 Projekte, dann sollen in seinem Register diese 8 Projekte nacheinander - ohne Leerzeile - erscheinen. Die Zeilen sollen zuerst aufsteigend nach der Spalte E „Start“, als zweites aufsteigend nach Spalte F „Dauer“, sortiert werden.
Für die anderen Mitarbeiter soll dies analog in den entsprechenden Mitarbeiter Registern (MA 2 bis MA 5) geschehen.
In den beiden Registern „Bsp. Daten Soll MA“ und „Bsp. Diagramm Soll MA“ habe ich das gewünschte Ergebnis schon einmal von Hand für MA 3 eingetragen.
P.S.: Für die Diagramme muß nichts gemacht werden. Ist alles schon vorbereitet.
Hier die Datei:
https://www.herber.de/bbs/user/62294.xls

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

Betreff
Datum
Anwender
Anzeige
AW: Mit VBA Zeilen in neue Register kopieren
08.06.2009 18:50:34
fcs
Hallo Andreas,
hier ein Beispielcode
Gruß
Franz

Sub MA_Daten()
Dim wksMA As Worksheet, lngZeileMA As Long, strNameMA As String
Dim wksPPL As Worksheet, lngZeilePPL As Long, lngI As Long
Dim arrMA
'Array mit den Mitarbeiternamen (muss mit den Blattnamen übereinstimmen!)
arrMA = Array("MA 1", "MA 2", "MA 3", "MA 4", "MA 5")
Set wksPPL = Worksheets("PPL")
'Mitarbeiterblätter zurücksetzen
For lngI = LBound(arrMA) To UBound(arrMA)
strNameMA = arrMA(lngI)
If fncWorkSheetCheck(wb:=ActiveWorkbook, strWsName:=strNameMA) = True Then
Set wksMA = Worksheets(arrMA(lngI))
With wksMA
lngZeileMA = .Cells(.Rows.Count, 1).End(xlUp).Row
'Inhalte in Spalten A bis F ab Zeile 2 löschen
If lngZeileMA >= 2 Then
.Range(.Cells(2, 1), .Cells(lngZeileMA, 6)).ClearContents
End If
End With
Else
MsgBox "Für Mitarbeiter """ & arrMA(lngI) & """ ist noch kein Auswerteblatt angelegt!"
End If
Next
With wksPPL
For lngZeilePPL = 16 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Spalte AC (29) prüfen
If LCase(.Cells(lngZeilePPL, 29))  "erledigt" Then
strNameMA = .Cells(lngZeilePPL, 7) 'Mitarbeitername Spalte G
If strNameMA  "" Then
If fncWorkSheetCheck(wb:=ActiveWorkbook, strWsName:=strNameMA) = True Then
Set wksMA = Worksheets(strNameMA)
With wksMA
'nächste freie Zeile im Mitarbeiterblatt
lngZeileMA = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lngZeileMA, 1).Value = wksPPL.Cells(lngZeilePPL, 4).Value 'Projektname
.Cells(lngZeileMA, 2).Value = wksPPL.Cells(lngZeilePPL, 3).Value 'Projekt-ID
.Cells(lngZeileMA, 3).Value = wksPPL.Cells(lngZeilePPL, 2).Value 'Phase
.Cells(lngZeileMA, 4).Value = wksPPL.Cells(lngZeilePPL, 28).Value 'ABCL
.Cells(lngZeileMA, 5).Value = wksPPL.Cells(lngZeilePPL, 21).Value 'Start
.Cells(lngZeileMA, 6).Value = wksPPL.Cells(lngZeilePPL, 22).Value 'Dauer
End With
Else
MsgBox "Für Mitarbeiter """ & strNameMA & """ ist noch kein Auswerteblatt angelegt!"
End If
End If
End If
Next
End With
'Mitarbeiterblätter sortieren
For lngI = LBound(arrMA) To UBound(arrMA)
strNameMA = arrMA(lngI)
If fncWorkSheetCheck(wb:=ActiveWorkbook, strWsName:=strNameMA) = True Then
Set wksMA = Worksheets(arrMA(lngI))
With wksMA
lngZeileMA = .Cells(.Rows.Count, 1).End(xlUp).Row
'Inhalte in Spalten A bis P ab sortieren
If lngZeileMA >= 3 Then
With .Range(.Cells(1, 1), .Cells(lngZeileMA, 16))
.Sort key1:=.Range("E1"), order1:=xlAscending, _
key2:=.Range("G1"), order2:=xlAscending, header:=xlYes
End With
End If
End With
Else
MsgBox "Für Mitarbeiter """ & arrMA(lngI) & """ ist noch kein Auswerteblatt angelegt!"
End If
Next
End Sub
Function fncWorkSheetCheck(wb As Workbook, strWsName As String) As Boolean
Dim objWs As Worksheet
For Each objWs In wb.Worksheets
If LCase(objWs.Name) = LCase(strWsName) Then
fncWorkSheetCheck = True
Exit For
End If
Next
End Function


Anzeige
AW: Mit VBA Zeilen in neue Register kopieren
09.06.2009 10:01:45
Andreas
Hallo Franz,
herzlichen Dank für Deine Hilfe. Das Makro hat wunderbar funktioniert.
Andreas

340 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige