Hallo Gast,
Ich habe deine Tips jetzt versucht einzufügen in den Code, bekomme aber sofort nach "Set Bereich = Intersect(Selection, UsedRange)" einen Sprung in den Error.
Muss ich vorher noch etwas ausführen, das der UsedRange erkannt wird oder so?


Sub Formel_Kopieren_mit_Erkennung()
  'vor dem Start des Makros den Zellbereich mit den zu kopierenden Formeln selektieren
  'Standard-Formeln kopieren ohne Anpassung der Zellbezüge
  Dim Bereich As Range, Zeile As Long, Spalte As Long
  Dim varAuswahl As Range
  On Error GoTo Fehler
 Set Bereich = Intersect(Selection, UsedRange)
  
  Set varAuswahl = Application.InputBox( _
      Prompt:="Bitte Startzelle für Ziel-Kopieren der Formeln auswählen", _
      Title:="Formeln kopieren ohne Bezugsanpassung", _
      Type:=8)
  For Zeile = 1 To Bereich.Rows.Count
  
    For Spalte = 1 To Bereich.Columns.Count
      With Bereich.Cells(Zeile, Spalte)
        If .HasArray Then
            varAuswahl.Offset(Zeile - 1, Spalte - 1).FormulaArray = .FormulaArray 'für Matrixformeln
         Else
          If .HasFormula Then
            varAuswahl.Offset(Zeile - 1, Spalte - 1).Formula = .Formula ' für Standardformeln
         Else
           If Not IsEmpty(.Cells) Then
            varAuswahl.Offset(Zeile - 1, Spalte - 1).Value = .Value
          Else
             varAuswahl.Offset(Zeile - 1, Spalte - 1).ClearContents
            End If
          End If
        End If
      End With
    Next
  Next
  
Fehler:
  With Err
    Select Case .Number
      Case 0 'Alles OK
      Case 424 'Keine Zelle in Inputbox gewählt
      Case Else
        MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
    End Select
  End With
End Sub