Nur bestimmte Spalten aus einem Arbeitsblatt in ein anderes kopieren

[FrankyHB]

Hallo zusammen,

ich habe ein Arbeitsblatt mit Personalstammdaten ("Personal") .

Nun möchte ich eine Geburtstagsliste in der selben Arbeitsmappe erstellen. ("Geburtstagsliste")

Das Arbeitsblatt mit den Personalstammdaten hat sieben Spalten (A:G)

Ich möchte nun die Spalte A (Name des Mitarbeiters) aus den Personaldaten in die Spalte B der Geburtstagsliste ab Zeile B9, sowie die Spalte D (Geb-Datum) aus den Personaldaten in die Spalte C der Geburtstagsliste ab Zeile C9 einfügen.

mit dem Code:

Dim i As Long, tLR As Long
Dim ZielWks As Worksheet, QuelleWks As Worksheet
Set QuelleWks = Worksheets("Personal")
Set ZielWks = Worksheets("Geburtstagsliste")
Worksheets("Geburtstagsliste").Rows("9:" & Worksheets("Geburtstagsliste").Rows.Count).ClearContents
With QuelleWks
    For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            tLR = ZielWks.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Debug.Print tLR
            With ZielWks
            .Range(.Cells(tLR, 1), .Cells(tLR, 7)).Value = QuelleWks.Range(QuelleWks.Cells(i, 1), _
QuelleWks.Cells(i, 7)).Value
            End With
      Next i
End With

kann ist zwar die ganze Tabelle komplett übertragen, aber ich bekomme es nicht hin, die einzelnen zwei Spalten zu importieren.
Die Spalte A sollte nach Monat gruppiert sein und Spalte C das Geburtsdatum in sortierter Reihenfolge enthalten.

Weiß jemand Rat?

Lieben Gruß

Frank

So sollte das fertige Ergebnis aussehen:
   

[Werner.M]

Hallo,

Code:

Public Sub Liste()
Dim loLetzte As Long, loLetzteZiel As Long, raBereich As Range

With Worksheets("Geburtstagsliste")
    loLetzteZiel = .Cells(.Rows.Count, "B").End(xlUp).Row
    If loLetzteZiel > 8 Then
        .Range("A9:C" & loLetzteZiel).ClearContents
    End If
    With Worksheets("Personal")
        loLetzte = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set raBereich = Union(.Range("A2:A" & loLetzte), .Range("D2:D" & loLetzte))
        raBereich.Copy
    End With
    .Range("B9").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    loLetzteZiel = .Cells(.Rows.Count, "B").End(xlUp).Row
    .Range("A9").FormulaLocal = "=TEXT(C9;""MMMM"")"
    .Range("A10:A" & loLetzteZiel).FormulaLocal = "=WENN(MONAT(C10)=MONAT(C9);"""";TEXT(C10;""MMMM""))"
    .Range("A9:A" & loLetzteZiel).Value = .Range("A9:A" & loLetzteZiel).Value
End With

Set raBereich = Nothing
Application.CutCopyMode = False
End Sub

Gruß Werner

[FrankyHB]

Sorry, ich habe einen Fehler gemacht:

Die Spalten im Zielbereich sollten wie folgt lauten:

Monat     Geb.Dateum     Mitarbeiter

Der Import der Daten klappt schon ganz gut, jecoch muß zuerst das Geb.Datum kommen und danach der Mitarbeiter-


Auch ist das Geburtsdatum noch nicht in Reihenfolge sortiert.


Aber trotzdem schon mal vielen lieben Dank.

Gruß Frank

[Werner.M]

Hallo,

also Salamitaktik ist nicht besonders erbauend. Vorher überlegen was, wann, wie passieren soll und dann erst den Beitrag schreiben.

Was hälst du davon, deine Datei hier mal zu posten und nicht irgendwelche Bildchen.

Gruß Werner

[PIVPQ]

Hallo

Wenn ich das ganze richtig verstehe, dann bin ich der Meinung, VBA muss nicht unbedingt sein.

[FrankyHB]

Hier ist die Beispieldatei

[Werner.M]

Hallo,

siehe deine Datei.

Gruß Werner

[FrankyHB]

Hallo Werner,

vielen vielen Dank, das ist es !!!

Gruß Frank