Makro soll zum Schluss bestimmte Zellen kopieren
09.08.2015 14:55:59
Jenny
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