Hi,

ich weiß nicht, ob ich dein Anliegen richtig verstanden habe.

Versuchs mal so (angenommen dein DropDown-Listenfeld befindet sich in A1)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim DestSheet As Worksheet
    Dim SourceSheet As Worksheet
    Dim sRow As Long 'row index on source worksheet
    Dim dRow As Long 'row index on destination worksheet
    Dim sCount As Long
    If Target.Address <> "$A$1" Then Exit Sub
    Worksheets("Risk Register").Activate
    Set DestSheet = Worksheets("Summary")
    Set SourceSheet = Worksheets("Risk Register")
    sCount = 0
    dRow = 17
    With SourceSheet
        For sRow = 1 To .Range("a65536").End(xlUp).Row
            'use pattern matching to find project "Changing the world" anywhere in cell
            If .Cells(sRow, "a") Like Target Then
                sCount = sCount + 1
                dRow = dRow + 1
                'copy cols A,F,E & D
                DestSheet.Cells(dRow, "d") = .Cells(sRow, "b")
                DestSheet.Cells(dRow, "e") = .Cells(sRow, "f")
                DestSheet.Cells(dRow, "f") = .Cells(sRow, "s")
                DestSheet.Cells(dRow, "g") = .Cells(sRow, "j")
                DestSheet.Cells(dRow, "h") = .Cells(sRow, "r")
            End If
        Next sRow
    End With
    MsgBox sCount & " Project Risks", vbInformation, "Transfer Done"
End Sub

Anstelle

.Range("a65536").End(xlUp).Row

würde ich für die letzte belegte Zelle dies verwenden:

IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)

Wenn A65536 nicht leer ist, ergibt deine Codezile einen falschen Wert.

Bis später,
Karin

Karin, danke vielmals!

Ich habe deinen Code leider nicht benutzen können, ich bin ja eine Niete in VBA. Da es sich um eine "Private" Deklaration handelt, wo muß ich den Code schreiben, unter "Standardmodule oder in Tabellenblatt "Summary", "Risk Register"?
Weiters: brauche ich auch eine Prozedur, um es zu aktivieren? Wenn ich auf Ausführen gehe, wird es nämlich nicht einmal aufgelistet.

Danke nochmals"

thol

Hi,

du musst den Code ins Codemodul der Tabelle kopieren, in der sich das DropDown-Listenfeld befindet - also Summary. Der Code wird automatisch ausgeführt, sobald du eine neue Auswahl triffst.

Übrigens sollte der Code auch funktionieren wenn du diese Codezeile Worksheets("Risk Register").Activate löschst. Sie ist noch aus deinem Ursprungscode und ich habe vergessen, sie zu entfernen.

Bis später,
Karin

Karin, danke nochmals für die schnelle Antwort, leider funktioniert es bei mir nicht. Habe alles gemacht, wie du gesagt hast: Statt A1 habe ich den Name genommen "selected_project", wo sie es bei mir steht. Die Liste / Dropdown feld ist eine verbundenen Zelle in summary e5:F5. Glaubst du dass das Problem hier liegt?

Danke

thol

Karin, ich habe den Fehler gefunden!
Ich hatte für die Spalte eineKleinbuchstabe genommen, deshalb hat es nicht funktionieren wollen. Danke!

Ich hätte nur noch eine Frage: wenn ich unter E5 (wo die dropdown liste mit den Projektnamen sind) ein Projekt nehme, das nur 2 Risks hat, vorher aber ein Projekt mit 30 Risks stand, löscht diese Code nicht die Daten, die schon da waren.

Ich würde brauchen, dass mit Auswahl eines neuen Projektes, die Daten von Risk Register ab Zeile 18 kopiert werden, jedes mal neu, d.h. alte Daten sollen "gelöscht" werden.

Kannst du mir noch einmal helfen???

Danke!

thol

Hi,

so ganz klar ist mir nicht, was gelöscht werden soll.
Wenn du den Code vor der Zeile mit der With-Anweisung durch diese Zeilen ergänzt, wird der Inhalt des Bereichs A18:Hxx gelöscht:

    With DestSheet
        .Range("A18:H" & IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)).ClearContents
    End With

Bis später,
Karin

Hallo Karin,

ich habe mit dem urspürnglichen Code ergänzt, aber irgendwas klappt nicht. Ich nehme an, dass ich mich nicht richtig ausgedruckt habe:

Der Code schaut so aus:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim DestSheet As Worksheet
Dim SourceSheet As Worksheet
Dim sRow As Long 'row index on source worksheet
Dim dRow As Long 'row index on destination worksheet
Dim sCount As Long

If Target.Cells.Address <> "$E$4" Then Exit Sub
Set DestSheet = Worksheets("Summary")
Set SourceSheet = Worksheets("Risk Register")
sCount = 0
dRow = 17

With SourceSheet
For sRow = 1 To .Range("a65536").End(xlUp).Row
'use pattern matching to find project "Changing the world" anywhere in cell
If .Cells(sRow, "a") Like Target Then
sCount = sCount + 1
dRow = dRow + 1
'copy cols A,F,E & D
DestSheet.Cells(dRow, "d") = .Cells(sRow, "b")
DestSheet.Cells(dRow, "e") = .Cells(sRow, "f")
DestSheet.Cells(dRow, "f") = .Cells(sRow, "s")
DestSheet.Cells(dRow, "g") = .Cells(sRow, "j")
DestSheet.Cells(dRow, "h") = .Cells(sRow, "r")

End If
Next sRow
End With
Application.ScreenUpdating = False
End Sub

Wenn ich in E4 / Summary (mittels dropdown) Project1 wähle, sucht er wie erwartet alle Risks in Risk Register und kopiert sie ab A18:H18. Wenn es angenommen 30 Risks sind, macht er das alles super. Aber wenn ich dann wieder ein neues Projekt nehme, Projekt2, das aber nur 5 Risks hat, kopiert er die Risks in den ersten 5 Reihen (ab A18, H18) lässt aber alle restlichen 25 Risks von Project1 drinnen. Die müssten eigentlich leer stehen. So jedes Mal wenn sich über dropdown das Projekt ändert.

Weiß du eine Lösung? Wäre für Hilfe sehr dankbar!

Danke
Thol

Hi,

in deinem Code sehe ich nicht, dass du ihn entsprechend meinem Beitrag vom 06.05.2008, 16:21 ergänzt hast.

Tipp: wenn du formatieren (eingerückten) Code in einen Beitrag kopierst, ihn anschließend markierst und den Schalter "Code" über dem Antwortfenster benutzt, wird der Code auch im Beitrag formatiert dargestellt und ist dadurch besser lesbar.

Bis später,
Karin

Sorry,

habe ich nicht gemacht, weil es nicht funktionierte. Wenn ich das einfüge (wie von dir gesagt vor dem ersten "with", löscht er alle Daten, die ab der ersten Reihe sind.

Es würde so ausschauen (wie ich das versucht habe:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim DestSheet As Worksheet
    Dim SourceSheet As Worksheet
    Dim sRow As Long 'row index on source worksheet
    Dim dRow As Long 'row index on destination worksheet
    Dim sCount As Long
    
    If Target.Cells.Address <> "$E$4" Then Exit Sub
    Set DestSheet = Worksheets("Summary")
    Set SourceSheet = Worksheets("Risk Register")
    sCount = 0
    dRow = 17
    With DestSheet
        .Range("D18:H" & IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)).ClearContents
    End With
    
    With SourceSheet
        For sRow = 1 To .Range("a65536").End(xlUp).Row
            'use pattern matching to find project "Changing the world" anywhere in cell
            If .Cells(sRow, "a") Like Target Then
                sCount = sCount + 1
                dRow = dRow + 1
                'copy cols A,F,E & D
                DestSheet.Cells(dRow, "d") = .Cells(sRow, "b")
                DestSheet.Cells(dRow, "e") = .Cells(sRow, "f")
                DestSheet.Cells(dRow, "f") = .Cells(sRow, "s")
                DestSheet.Cells(dRow, "g") = .Cells(sRow, "j")
                DestSheet.Cells(dRow, "h") = .Cells(sRow, "r")
                                      
            End If
        Next sRow
    End With
  Application.ScreenUpdating = False
End Sub

Hoffe, du kannst mir helfen.
Bis gleich

Thol

Hi,

das habe ich ja auch geschrieben und gleichzeitig angemerkt, dass mir nicht ganz klar ist, was gelöscht werden soll. Das ist mir nun leider immer noch unklar.

Deine Beschreibung:



und genau das macht der Code.

Bis später,
Karin

Hallo Karin,

danke, und gleichzeitig entschuldige, dass ich insistiere:

Wenn ich Projekt1 mit 30 Risks, werden Daten ab A18:H18 bis A47:H47 (d.h. die 30 Zeilen) kopiert. Wenn Projekt2 nur 5 Risks hat, müsste in diesen Range (den ich Summary_Selected genant habe, also A18:H18 bis zum Ende der Tabelle) nur die 5 Risks stehen, die alten von Projekt1 (also A18:H18 bis A22:H22) mit Risks von Projekt2 sollten überschrieben werden, ab A23:H23 sollten die alten Risks von Projekt1 "gelöscht" werden, sodass ich immer eine Übersicht mit den und nur mit den Risks von den "neuen Auswahl" sehe.

Hoffe, diesmal habe ich mich besser ausgedruckt.

Danke

Thol

Entschuldigung: es geht nicht um Spalte A sondern um Spalte D. Der Bereich beginnt in der Spalte D. Also zu meiner vorherige Anfrage: es ist immer D und nicht A.

Danke
Thol

Hi,

ändere in

IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)).

die 1 in eine 4, dann wird in Spalte D letzte die belegte Zelle ermittelt.

Bis später,
Karin

DANKE!!! Jetzt hat es geklappt,

Thol