Guten Morgen,

hier ist der Code:Sub HP_erstellen()
  ' liest die variablen Daten eines HP aus dem jeweiligen Register "HP_Datenbank" und
  ' überträgt sie in das Register "HP"
 
  'Call aufraeumen
 
Application.ScreenUpdating = False

 
  Dim hp_daten_pos(300) As String     ' enthält die Feldnamen
  Dim hp_daten_hoehe(300) As Integer  ' 0: wenn hpdaten(i)="" dann Zeilenhöhe = 0, 1: keine Aktion
  Dim hp_daten(300) As String         ' enthält die Feldinhalte
  Dim register As String
 
  ' Namen des aktiven Registers bestimmen
  register = ActiveSheet.name
 
  Call ZeileSpalteBestimmen(ze, sp)
 
  If register = "HP_Datenbank" And ze >= 5 Then
    For ii = 1 To 300
      hp_daten_pos(ii) = Cells(3, ii)
      hp_daten_hoehe(ii) = Cells(4, ii)
      hp_daten(ii) = Cells(ze, ii)
    Next ii
    
    Sheets("HP").Select
    
    
    For ii = 1 To 300
      If hp_daten_pos(ii) <> "" Then
        Let Err = 0
        On Error Resume Next
        Range(hp_daten_pos(ii)).Select
        If Err = 1004 Then MsgBox "Das Feld " & hp_daten_pos(ii) & " existiert nicht!"
        On Error GoTo 0
        
        Range(hp_daten_pos(ii)).Select
        '
        ' wenn keine Daten und Höhe = 0, dann Zeilenhöhe auf 0 setzen
        If hp_daten(ii) = "" And hp_daten_hoehe(ii) = 0 Then
          ActiveCell.RowHeight = 0
        ' wenn <DEL>, dann Zeilenhöhe auf 0 setzen
        ElseIf hp_daten(ii) = "<DEL>" Then
          ActiveCell.RowHeight = 0
          
        ' Seitenumbruch einfügen: <PB> = PageBreak
        ElseIf hp_daten(ii) = "<PB>" Then
          Call ZeileSpalteBestimmen(ze2, sp2)
          Rows(ze2).Select
          ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
        Else
          
          
          
          ActiveCell.Select
          
          
           If Left(hp_daten(ii), 6) = "<FORM>" Then
          
            hp_daten(ii) = Right(hp_daten(ii), Len(hp_daten(ii)) - 6)
            ActiveCell.FormulaLocal = hp_daten(ii)
                      
          Else
          
            ActiveCell.Value = hp_daten(ii)
          
          End If
        
        
        End If
      End If
    Next ii
    
    SendKeys "(^{home})", True
    Cells(3, 2).Select
  End If

'Call FormelnErsetzen

Application.ScreenUpdating = True

End Sub

Vielen Dank und viele Grüße