in der Beispieldatei sind zwei Tabellen in einem Tabellenblatt.
Problem 1:
Aus Tabelle2 sollen die Werte der Zeile von Spalte A-R in eine neue, untere Zeile der Tabelle1 kopiert werden, wenn in Spalte Q von Tabelle2 "Ja" steht und die Schaltfläche "kopieren" geklickt wird.
Ich hab hier einen Code, mit dem es nicht klappt - und ihr wisst bestimmt wieso... :21: :20:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iRow As Integer
If Target.Column <> 19 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
If UCase(Target.Value) = "Ja" Then
With Worksheets("Tabelle1")
iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Rows(Target.Row).copy .Rows(iRow)
End With
End If
Application.CutCopyMode = False
End Sub
Problem 2:
Aus einer Userform lässt sich in einer anderen Datei eine PDF entsprechend des Namens in Listbox1 öffnen. Also steht in der Listbox "X", wird die PDF mit dem Namen "X" geöffnet:
'PDF aufrufen mit Kriterium "Nachname"
Private Sub cmdMuster_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Jetzt soll in der Beispieldatei in Spalte C von Tabelle1 ein Name stehen. Wenn in Spalte S "Ja" gewählt und "PDF anzeigen" geklickt wird, soll die PDF sich öffnen, die unter dem Namen in Spalte C gespeichert ist.
Zu 1:
danke für den Hinweis. Hab versehentlich "Spalte Q" geschrieben: gemeint ist Spalte S. Also "19" haut schon hin. Aber mit dem Code läufts's trzd nicht hin...
Zu 2:
Habe erst morgen wieder Zugriff auf die Datei mit der Userform bzw. Speicherort der PDF.
12.09.2019, 18:50 (Dieser Beitrag wurde zuletzt bearbeitet: 12.09.2019, 18:50 von Mase.)
zu 1)
Bin Deinem Code treu geblieben:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngRow As Long
If Target.Column <> 19 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
If UCase(Target.Value) = "JA" Then
With Worksheets("Tabelle1")
lngRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets(2).Rows(Target.Row).Copy .Rows(lngRow)
End With
End If
Application.CutCopyMode = False
End Sub
Hinweis:
Das Ereignis/Deine Zeilen funktionieren dann, wenn Du in Spalte S "Ja" (oder "JA" oder "ja" oder "jA") eingibst und den Editiermodus verlässt.
Warum? Weil Du IsEmpty(Target) Then Exit Sub verwendest und noch vieles mehr...
Frage:
Warum dieses Ereignis verwenden, wenn Du eine Schaltfläche verwenden willst?
Ich komme ursprünglich von der Übungsdatei hier
139601v.xls (Größe: 37 KB / Downloads: 0)
und wollte den Code dort auf meinen recht ähnlichen Fall zurecht münzen. Die Schaltfläche soll den Anwendern dienen, die noch weniger Peil von der Materie haben als ich.
Leider kopiert sich nach wie vor nichts...
Weiß ja nicht wo Du den Code reingeschrieben hast, aber geh mal auf Tabelle2, trage in den Spalten von A-R etwas ein, und abschließend ein "Ja" in Spalte S.
Danke Marco für deine Bemühungen. Soweit war ich auch schon. Das Problem ist dadurch jedoch nicht gelöst.
Ich zitiere noch Mal:
"in der Beispieldatei sind zwei Tabellen in einem Tabellenblatt (...)"
Gut möglich, dass ich mich nicht präzise genug ausgedrückt habe - sorry. Die Party soll ausschließlich in dem einen Tabellenblatt (Tabelle1) stattfinden, in dem sich wiederum Tabelle1+2 befinden, die Quell- bzw Zieltabellen sind.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim lngRow As Long
If Target.Column <> 19 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
'If UCase(Target.Value) = "JA" Then
If Target.Value = 1 Then
Call CopyListObjectRow(Target.Row, Target.Column)
End If
Application.CutCopyMode = False
Application.EnableEvents = True
End Sub
Und das hier in ein Modul:
Code:
Sub CopyListObjectRow(lngRow As Long, lngCol As Long)
Dim wkb As Workbook
Dim wks As Worksheet
Dim lob1 As ListObject
Dim lob2 As ListObject
Dim arr() As Variant
'
Set wkb = Workbooks("Beispiel.xlsm")
Set wks = wkb.Worksheets(1)
Set lob1 = wks.ListObjects("lstTabelle1")
Set lob2 = wks.ListObjects("lstTabelle2")
'
With lob2
arr = .ListRows(lngRow - .HeaderRowRange.Row).Range
End With
With lob1
.ListRows.Add .ListRows.Count + 1, False
.ListRows(.ListRows.Count).Range = arr
End With
'
Set wks = Nothing: Set wkb = Nothing
End Sub
Die Datei pack ich trotzdem nochmal rein, damit Du Sie runterladen kannst, aber der Interessierte (m/w/d) nicht runterladen muss.
Hinweis:
Der Button "kopieren" wird nicht versetzt; das könntest Du lösen, oder :)
