Makro soll zum Schluss bestimmte Zellen kopieren

Bild

Betrifft: Makro soll zum Schluss bestimmte Zellen kopieren
von: Jenny
Geschrieben am: 09.08.2015 14:55:59

Hallo an alle,
helft ihr mir bitte dafür zu sorgen, dass das Makro am Ende des Ausführens die letzte Zeile mit Inhalt in Spalte H der Tabelle 1 sucht (es gibt zwischendrin keine Leerzellen in Spalte H) und aus dieser Zeile die Zellen H bis M in die Zwischenablage kopiert?
Jedoch noch nirgendwo anders einfügt, wo es eingefügt werden soll will ich dann individuell entscheiden.
Außerdem wäre es auch schön wenn dann auch diese besagte Zeile eingeblendet wird, die ca. 3000 Zeilen vor der insgesamt letzten Zeile ist.
Hänge mal eine Bsp. Datei an, musste allerdings vieles was für das bisherige Makro relevant war aus Gründen der maximalen Dateigröße löschen, daher hab ich mich auf das beschränkt was für meine jetzige Bitte notwendig ist
https://www.herber.de/bbs/user/99439.xlsm
Auf mein Beispiel bezogen, bislang wird immer die letzte Zeile mit Inhalt in Spalte A eingeblendet nach Ausführen des Makros, also in dem Beispiel Zeile 1000.
Zuküftig würd ich mir wünschen dass die letzte Zeile mit Inhalt in Spalte H gesucht wird, also in meinem Beispiel Zeile 500. Aus dieser Zeile sollen die SpaltenH bisM in die Zwischenablage eingefügt werden, also in meinem Beispiel Zellen H500:M500
und statt der Zeile 1000 soll auch nach dem Ausführen dann die Zeile 500 angezeigt werden. Nur dass diese Zeilen bei jedem Ausführen andere sind, also man sich nicht auf die Zeile 500 festlegen kann.
Geht das irgendwie?
LG
Jenny

Sub Makro3()
'
' Makro3 Makro
'
' Tastenkombination: Strg+i
'
        Dim zt1&, von&, bis As Long
       Dim Grafiken As Shape
       Dim c As Range, a As Variant
       Application.ScreenUpdating = False
       With Sheets("Tabelle1")
           zt1 = .Cells(.Rows.Count, 1).End(xlUp).Row
           von = 1
           With Sheets("Tabelle2")
               bis = .Cells(.Rows.Count, 2).End(xlUp).Row
               .Range(.Cells(von, 2), .Cells(bis, 2)).Copy Sheets("Tabelle1").Cells(zt1, 6)
           End With
           With Sheets("Tabelle3")
               .Range(.Cells(von, 5), .Cells(bis, 5)).Copy
           End With
           .Cells(zt1, 7).PasteSpecial Paste:=xlPasteValues
           Application.CutCopyMode = False
          If bis > 1 Then
               .Range(.Cells(zt1, 1), .Cells(zt1, 3)).Copy _
                Destination:=.Range(.Cells(zt1 + 1, 1), .Cells(zt1 + bis - von, 1))
          End If
           Application.CutCopyMode = False
           
     Sheets("Tabelle1").Range("D" & zt1 - 1 & ":E" & zt1 - 1).Copy _
    Sheets("Tabelle1").Range("D" & zt1 & ":E" & zt1 + bis - von)
 
           For Each c In Range(.Cells(zt1, 6), .Cells(zt1 + bis - von + 1, 6))
             If c.Hyperlinks.Count > 0 Then
                a = Split(c.Hyperlinks(1).Address, "/")
                c.Offset(0, -1).Value = a(UBound(a) - 1)
             End If
           Next
          .Range(.Cells(1, 1), .Cells(zt1 + 1 + bis - von, 14)).Sort _
           key1:=.Range("D1"), Order1:=xlAscending, _
          key2:=.Range("G1"), Order2:=xlDescending, Header:=xlNo
       End With
       With Sheets("Tabelle2")
           .Range(.Cells(1, 1), .Cells(bis, 3)).Clear
       End With
       With Sheets("Tabelle3")
        .Range(.Cells(1, 1), .Cells(bis, 4)).Clear
         For Each Grafiken In .Shapes
               Grafiken.Delete
         Next
       End With
       Application.ScreenUpdating = True
   End Sub



Bild

Betrifft: AW: Makro soll zum Schluss bestimmte Zellen kopieren
von: AlexG
Geschrieben am: 09.08.2015 17:12:21
Hallo Jenny,
meintest du das so?

With Sheets("Tabelle1").Cells(Rows.Count, 8).End(xlUp)
    .Resize(1, 6).Copy
    .Activate
End With

Gruß
Alex

Bild

Betrifft: AW: Makro soll zum Schluss bestimmte Zellen kopieren
von: Jenny
Geschrieben am: 09.08.2015 19:19:54
Hallo Alex,
ich muss zugeben, als jemand der das liest ist es wirklich schwer verständlich was ich will.
Aber trotzdem hast du den Nagel auf den Kopf getroffen. Danke.
LG
Jenny

Bild

Betrifft: AW: Makro soll zum Schluss bestimmte Zellen kopieren
von: Jenny
Geschrieben am: 09.08.2015 19:33:18
Hallo Alex,
ich muss leider doch zurückrudern. Es funktioniert nur, wenn ich beim Starten des Makros in Tabelle1 bin. Vorher lief das Makro auch, wenn ich es aus einem anderen Tabellenblatt gestartet hab. In diesem Fall kommt jetzt Laufzeitfehler 1004 und deine Zeile .Activate wird nun beim Debuggen gelb markiert.
Kannst du da bitte nochmal nach schaun?
LG
Jenny

Bild

Betrifft: AW: Makro soll zum Schluss bestimmte Zellen kopieren
von: AlexG
Geschrieben am: 09.08.2015 19:46:22
Hallo Jenny,
so sollte es klappen :-)

Sheets("Tabelle1").Activate
With Cells(Rows.Count, 8).End(xlUp)
    .Resize(1, 6).Copy
    .Activate
End With

Gruß
Alex

Bild

Betrifft: AW: Makro soll zum Schluss bestimmte Zellen kopieren
von: Jenny
Geschrieben am: 09.08.2015 21:36:30
Hallo Alex,
leider auch noch nicht so ganz, jetzt wird zwar die richtigen Zellen kopiert aber es wird nach wie vor die insgesamt letzte Zelle angezeigt
LG
Jenny

Bild

Betrifft: So nicht nachvollziehbar
von: AlexG
Geschrieben am: 10.08.2015 10:17:05
Hallo Jenny,
ich kann dir leider auch nicht sagen woran das liegt. In deiner Beispieldatei funktioniert es ja.
Eine andere Möglichkeit ist, anstelle des aktivieren der kopierten Zellen, zur Zeile zu Scrollen.

Sheets("Tabelle1").Activate
With Cells(Rows.Count, 8).End(xlUp)
    .Resize(1, 6).Copy
    ActiveWindow.ScrollRow = .Row
End With

Gruß
Alex

Bild

Betrifft: AW: So nicht nachvollziehbar
von: Jenny
Geschrieben am: 10.08.2015 13:38:59
Hallo Alex, schau mal bitte nochmal rein, vielleicht hab ichs ja auch an die falsche Stelle kopiert.

Sub Makro3()
'
' Makro3 Makro
'
' Tastenkombination: Strg+i
'
        Dim zt1&, von&, bis As Long
       Dim Grafiken As Shape
       Dim c As Range, a As Variant
       Application.ScreenUpdating = False
       With Sheets("Tabelle1")
           zt1 = .Cells(.Rows.Count, 1).End(xlUp).Row
           von = 1
           With Sheets("Tabelle2")
               bis = .Cells(.Rows.Count, 2).End(xlUp).Row
               .Range(.Cells(von, 2), .Cells(bis, 2)).Copy Sheets("Tabelle1").Cells(zt1, 6)
           End With
           With Sheets("Tabelle3")
               .Range(.Cells(von, 5), .Cells(bis, 5)).Copy
           End With
           .Cells(zt1, 7).PasteSpecial Paste:=xlPasteValues
           Application.CutCopyMode = False
          If bis > 1 Then
               .Range(.Cells(zt1, 1), .Cells(zt1, 3)).Copy _
                Destination:=.Range(.Cells(zt1 + 1, 1), .Cells(zt1 + bis - von, 1))
          End If
           Application.CutCopyMode = False
           
     Sheets("Tabelle1").Range("D" & zt1 - 1 & ":E" & zt1 - 1).Copy _
    Sheets("Tabelle1").Range("D" & zt1 & ":E" & zt1 + bis - von)
 
           For Each c In Range(.Cells(zt1, 6), .Cells(zt1 + bis - von + 1, 6))
             If c.Hyperlinks.Count > 0 Then
                a = Split(c.Hyperlinks(1).Address, "/")
                c.Offset(0, -1).Value = a(UBound(a) - 1)
             End If
           Next
          .Range(.Cells(1, 1), .Cells(zt1 + 1 + bis - von, 14)).Sort _
           key1:=.Range("D1"), Order1:=xlAscending, _
          key2:=.Range("G1"), Order2:=xlDescending, Header:=xlNo
       End With
       With Sheets("Tabelle2")
           .Range(.Cells(1, 1), .Cells(bis, 3)).Clear
       End With
       With Sheets("Tabelle3")
        .Range(.Cells(1, 1), .Cells(bis, 4)).Clear
         For Each Grafiken In .Shapes
               Grafiken.Delete
         Next
       End With
       Sheets("Tabelle1").Activate
With Cells(Rows.Count, 8).End(xlUp)
    .Resize(1, 6).Copy
    .Activate
End With
       Application.ScreenUpdating = True
   End Sub


Bild

Betrifft: AW: So nicht nachvollziehbar
von: AlexG
Geschrieben am: 10.08.2015 13:54:27
Hallo Jenny,
die With Klammer muss hinter das Application.ScreenUpdating=True
Das Ende sieht dann z.B. so aus.

       Sheets("Tabelle1").Activate
       Application.ScreenUpdating = True
       With Cells(Rows.Count, 8).End(xlUp)
        .Resize(1, 6).Copy
        .Activate
       End With

Gruß
Alex

Bild

Betrifft: AW: So nicht nachvollziehbar
von: Jenny
Geschrieben am: 10.08.2015 23:03:13
Danke, so funktioniert es.
LG
Jenny

Bild

Betrifft: Bitte, freut mich. Gruß Alex (owT)
von: AlexG
Geschrieben am: 10.08.2015 23:46:34


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Makro soll zum Schluss bestimmte Zellen kopieren"