habe ein Problem mit diesem Makro hier:
Sub Makro1()
' Makro1 Makro
' Tastenkombination: Strg+i
Dim i, 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, 4)).Copy _
Destination:=.Range(.Cells(zt1 + 1, 1), .Cells(zt1 + bis - von, 1))
End If
Application.CutCopyMode = False
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, 15)).Sort _
'key1:=.Range("C1"), 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
'Application.ScreenUpdating = True
'If Application.CountA(Columns(8)) > 0 Then
'If IsEmpty(Cells(1, 8)) Then
'With Cells(1, 8).End(xlDown)
'.Resize(1, 8).Copy
'.Activate
'End With
'Else
' For i = 1 To Cells(Rows.Count, 8).End(xlUp).Offset(1).Row
' If IsEmpty(Cells(i, 8)) Then
' With Cells(i, 8).Offset(-1, 0)
' .Resize(1, 8).Copy
' .Activate
' End With
' Exit Sub
'End If
' Next i
' End If
' End If
End Sub
genau genommen mit dem TeilFor 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
ab Zeile 65531 bleibt die Spalte E leer.Hat da jemand einen Rat?
Danke und Gruß
Jenny