Hallo,

als erstes fällt mir auf, dass Du den gesamten inhalt der Tabelle mittels copy und inhalte einfügen in Werte umwandelst. Das geht mE so schneller:

    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

Du löscht die ausgeblendeten Zeilen/ Spalten einzeln. Das ist mega zeitaufwändig. Du solltest mehrere ausgeblendete Spalten bzw.ö Zeilen zusammen löschen. Alles zusammen wäre das optimale, was aber nur richtig und performant funktioniert, wenn nicht zu viele nicht zusammenhängende Bereiche bestehen. Ich hatte mal was Ähnliches und habe so gelöst (umgeschrieben auf Deinen Code):

Public Sub Ausgeblendetloeschen()
    Dim lngIndex As Long
    Dim strDelete As String
    Dim strTemp As String
    'Application.ScreenUpdating = False   -> Wird in der Hauptroutine schon gemacht
    For lngIndex = 1 To 256
        If Columns(lngIndex).Hidden Then
            If strTemp <> "" Then
                If Not Range(strTemp & ":" & strTemp).Column = lngIndex - 1 Then
                    strDelete = strDelete & ":" & strTemp & ", "
                    strDelete = strDelete & Left(Columns(lngIndex).Address(, False), InStr(Columns(lngIndex).Address(, False), ":") - 1)
                End If
            Else
                strDelete = Left(Columns(lngIndex).Address(, False), InStr(Columns(lngIndex).Address(, False), ":") - 1)
            End If
            strTemp = Columns(lngIndex).Address(, False)
            strTemp = Left(strTemp, InStr(strTemp, ":") - 1)
        End If
    Next
    strDelete = strDelete & ":" & strTemp
    If strDelete <> ":" Then Range(strDelete).Delete
    For lngIndex = 1 To 65535
        If Rows(lngIndex).Hidden Then
            If strTemp <> "" Then
                If Not Range(strTemp & ":" & strTemp).Row = lngIndex - 1 Then
                    strDelete = strDelete & ":" & strTemp & ", "
                    strDelete = strDelete & CStr(lngIndex)
                End If
            Else
                strDelete = CStr(lngIndex)
            End If
            strTemp = CStr(lngIndex)
        End If
    Next
    strDelete = strDelete & ":" & strTemp
    If strDelete <> ":" Then Range(strDelete).Delete
    'Application.ScreenUpdating = True   -> Es hier wieder einzuschlaten wäre Kontraproduktiv ;)
End Sub

Das sollte bei nicht allzu vielen ausgeblendeten Bereichen funktionieren.

Folgendes kannst Du anpassen:

    'Spalten K-Z löschen
    Columns("K:Z").Delete Shift:=xlToLeft
    'Ist das noch K-Z? Denn die ausgeblendeten wurden gelöscht, evtl. K-Z vorher löschen

Damit sollte die Prozedur um einiges schneller laufen.

Gruß

Michael