Hyperlink übertragen, zweiter Fall.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Eisi,
es müsste zuerst inklusiv Formatierung übertragen werden, dann nur die Value:


.Cells(lastrow, 2).PasteSpecial Paste:=xlPasteAllUsingSourceTheme 'Überträgt die Formatierung.
.Cells(lastrow, 2).PasteSpecial Paste:=xlValues 'Fügt die kopierten Werte ein.

Um den Spaghetti-Code zu vermeiden, da die beide Funktionen sich nur an einer einzigen Stelle unterscheiden, kannst Du die Parameter übergeben:


Sub KopierenNach(Versatz As Integer)
lastrow = .Cells(.Rows.Count, 2).End(xlUp).Row + Versatz ' Letzte Zelle in Spalte 6 (F) suchen + 2 oder 9 Zeilen darunter einfügen
End Sub

Es wird dann so gerufen:


Sub AngebotsMengePlattenUebertragen()
If (Sheets("2_Positionen").Range("B10"))  "" Then
KopierenNach Versatz:=2
Else
KopierenNach Versatz:=9
End If
End Sub

Die Benennung der Variablenname ist nicht notwendig. KopierenNach 2 und KopierenNach 9 würde auch funktionieren.
VG
Yal

Sub KopierenNach(Versatz As Integer) Dim LetzteZeile As Long Application.ScreenUpdating = False With tbl_1_Kalkulation .Range("A22:P34").AutoFilter Field:=2, Criteria1:="" ' 1) Filter setzen und leere Zellen ausblenden .Range("F15:P43").Copy ' 2) Kompletten Tabellenbereich kopieren End With ' 3) Letzte Zelle in Spalte 6 (F) 12 (L) (letzte Spalte) suchen und den kopierten Bereich 2 Zellen darunter einfügen With tbl_2_Positionen LetzteZeile = .Cells(.Rows.Count, 2).End(xlUp).Row ' Letzte Zelle in Spalte 6 (F) suchen + 2 Zeilen darunter einfügen .Cells(LetzteZeile + Versatz, 2).PasteSpecial Paste:=xlPasteAllUsingSourceTheme 'Überträgt die Formatierung. .Cells(LetzteZeile + Versatz, 2).PasteSpecial Paste:=xlValues 'Fügt die kopierten Werte ein. .Range("B10:L" & LetzteZeile).Borders(xlEdgeBottom).Weight = xlMedium ' Formatiere die letzte Linie fett. End With Application.Goto tbl_1_Kalkulation.Range("A13") tbl_1_Kalkulation.AutoFilterMode = False Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

Sub KopierenNach(Versatz As Integer) Dim LetzteZeile As Long Application.ScreenUpdating = False tbl_1_Kalkulation.Range("A22:P34").AutoFilter Field:=2, Criteria1:="" ' 1) Filter setzen und leere Zellen ausblenden ' 3) Letzte Zelle in Spalte 6 (F) 12 (L) (letzte Spalte) suchen und den kopierten Bereich 2 Zellen darunter einfügen With tbl_2_Positionen LetzteZeile = .Cells(.Rows.Count, 2).End(xlUp).Row ' Letzte Zelle in Spalte 6 (F) suchen + 2 Zeilen darunter einfügen tbl_1_Kalkulation.Range("F15:P43").Copy ' 2) Kompletten Tabellenbereich kopieren .Cells(LetzteZeile + Versatz, 2).PasteSpecial Paste:=xlPasteAllUsingSourceTheme 'Überträgt die Formatierung. tbl_1_Kalkulation.Range("F15:P43").Copy ' 2) Kompletten Tabellenbereich kopieren .Cells(LetzteZeile + Versatz, 2).PasteSpecial Paste:=xlPasteValues 'Fügt die kopierten Werte ein. .Range("B10:L" & LetzteZeile).Borders(xlEdgeBottom).Weight = xlMedium ' Formatiere die letzte Linie fett. End With Application.Goto tbl_1_Kalkulation.Range("A13") tbl_1_Kalkulation.AutoFilterMode = False Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

Hallo Eisi,
man, man, man! Ich habe lange gebraucht, bis ich verstanden habe voran das liegt.
Die bisherige Fehlermeldung sind wegen den verbundenen Zellen. Soweit schnell entdeckt.
Aber:
in H21 steht zwar einen Link, diese wird aber per Formel ermittelt und auch durch die Formel mit einem "lesbaren Text" angezeigt. Ich kann daraus den Link nicht auslesen. Und auch nicht die Formel "evaluieren", weil ich dann nur den lesbaren Text herausziehen würde.
Am einfachste wäre, Du verwendest irgendwo eine versteckte Zelle, wo der erste Teil diese HYPERLINKS() Formel, der für das Erzeugen des Links zuständig ist, reinkommt. Dann kann man den Wert dieses Links gezielt lesen und einsetzen:


Sub KopierenNach()
Dim LetzteZeile As Long
Application.ScreenUpdating = False
tbl_1_Kalkulation.Range("A22:P34").AutoFilter Field:=2, Criteria1:=""  ' 1) Filter setzen und leere Zellen ausblenden
tbl_1_Kalkulation.Range("F15:P43").Copy '29 Zeilen, 11 Spalten (für den Resize)
' 3) Letzte Zelle in Spalte 6 (F) 12 (L) (letzte Spalte) suchen und den kopierten Bereich 2 Zellen darunter einfügen
With tbl_2_Positionen
LetzteZeile = .Range("F99999").End(xlUp).Row + 2 ' Letzte Zelle in Spalte 6 (F) suchen + 2 Zeilen darunter einfügen
'keine Versatz mehr: wenn unter 10, 10 nehmen
If LetzteZeile

Im Teil


'Hyperlink separat einsetzen
.Hyperlinks.Add .Cells(LetzteZeile + 6, 4), tbl_1_Kalkulation.Range("X21").Value

müsstest Du dann die dritte Anteil eventuell den X21 anpassen, falls Du den Link-Adresse nicht in X21 hast
Ich habe bei der Gelegenheit entdeckt, warum die Prüfung B10 "" und ersetzt mit einem


If LetzteZeile

Prüfung von B10 und Übergabe von Parameter sind dann nicht mehr notwendig.
Auch die dicke Linie ganz unten wäre wahrscheinlich nicht richtig gesetzt worden.
Viel Erfolg damit
VG
Yal

Beliebteste Forumthreads (12 Monate)

Hyperlink übertragen, zweiter Fall.

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread