Zeile kopieren + PDF öffnen

[DN_89]

Hallo,

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)

  ThisWorkbook.FollowHyperlink "N:\...\" & Me.ListBox1.Column(2) & ".pdf"

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.

Wie stell ich das denn an?


---------------------

Vielen Dank im Voraus!

[Mase]

Hi,

zu Problem 1)
Der Buchstabe Q steht an welcher Stelle des Alphabets? 

zu Problem 2)
Mach mal ne MsgBox und poste den Rückgabewert:

Code:

'Also:
MsgBox "N:\...\" & Me.ListBox1.Column(2) & ".pdf"

[DN_89]

Hi Marco,

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.

LG Dennis

[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?

[DN_89]

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...

[Mase]

zu 1)

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.

[DN_89]

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.

LG

[Mase]

Ah ja, verstehe.

Pack das mal in den Codebereich der Tabelle1:

Code:

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  :)

[DN_89]

danke, komme erst morgen wieder dazu, mir das wieder genauer anzusehen.

gruß