Automatisk flytning til specifik celle i et ulåst excelark

Du kan benytte din makro til at slå beskyttelsen til/fra ... vil det ikke løse dit problem ???

Sub Kode()

Sheets("Dit Ark").Unprotect

resten af din kode

Sheets("Dit Ark").Protect

End Sub

Nej det virker ikke. Jer er nybegyndende amatør på makroudvikling, så at ting virker er lidt af et mirakel for mig.
Jeg har fået fat i en makro, som gøre, at man ved aktivering af denne (hos mig med  ctrl+z) får gjort at selv flettede celler automatisk får udvidet rækkehøjden så al tekst kan ses selv ved over en linies tekst, hvilket ellers ikke er muligt i flettede celler. De makro der aktiveres ved CTRL+Z er

    Public Sub AutoFitMergedCellRowHeight()
    Dim iCurrentRowHeight As Single
    Dim iMergedCellRgWidth As Single
    Dim iActiveCellWidth As Single
    Dim iPossNewRowHeight As Single
    Dim rCurCell As Range
   
    If ActiveCell.MergeCells Then
      With ActiveCell.MergeArea
            If .Rows.Count = 1 And .WrapText = True Then
                Application.ScreenUpdating = False
                .EntireRow.AutoFit
                iCurrentRowHeight = .RowHeight
                iActiveCellWidth = ActiveCell.ColumnWidth
                For Each rCurCell In Selection
                    iMergedCellRgWidth = rCurCell.ColumnWidth + iMergedCellRgWidth
                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = iMergedCellRgWidth
                .EntireRow.AutoFit
                iPossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = iActiveCellWidth
                .MergeCells = True
                .RowHeight = IIf(iCurrentRowHeight > iPossNewRowHeight, _
                iCurrentRowHeight, iPossNewRowHeight)
            End If
        End With
    End If

    Set rCurCell = Nothing
End Sub


Jeg ville helst om denne makro kørte automatisk når man trykkede enter efter færdigskrivning i cellen. Det kan jeg ikke finde ud af. I stedet har jeg så indsat i arkets programkode den makro angivet herunder, der aktiveres i udvalgte celler ved tryk på enter, og som giver en Messageboks, der fortæller at man nu kan trykke ctrl+z ved behov.

Private Sub Worksheet_Change(ByVal Target As Range)

If Not (Intersect(Target, Rows(20), Columns(1)) Is Nothing) Then
MsgBox "Hvis teksten er længere end cellelængden skal du trykke ctrl+z efter indskrivningen for at øge rækkehøjden automatisk og dermed tillade at al tekst ses"
End If
End Sub

Dette virker men er lidt kluntet. Kan man ikke i stedet for at køre mesageboksen få kørt makroen??.Jeg har prøvet at erstatte messagebox kaldet med at kalde makroen som angivet herunder .

Private Sub Worksheet_Change(ByVal Target As Range)

If Not (Intersect(Target, Rows(20), Columns(1)) Is Nothing) Then
call  AutoFitMergedCellRowHeight
End If
End Sub

og også prøvet at kopiere hele makroteksten ind

    Private Sub Worksheet_Change(ByVal Target As Range)
   
    Dim iCurrentRowHeight As Single
    Dim iMergedCellRgWidth As Single
    Dim iActiveCellWidth As Single
    Dim iPossNewRowHeight As Single
    Dim rCurCell As Range
   
    If ActiveCell.MergeCells Then
      With ActiveCell.MergeArea
            If .Rows.Count = 1 And .WrapText = True Then
                Application.ScreenUpdating = False
                .EntireRow.AutoFit
                iCurrentRowHeight = .RowHeight
                iActiveCellWidth = ActiveCell.ColumnWidth
                For Each rCurCell In Selection
                    iMergedCellRgWidth = rCurCell.ColumnWidth + iMergedCellRgWidth
                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = iMergedCellRgWidth
                .EntireRow.AutoFit
                iPossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = iActiveCellWidth
                .MergeCells = True
                .RowHeight = IIf(iCurrentRowHeight > iPossNewRowHeight, _
                iCurrentRowHeight, iPossNewRowHeight)
            End If
        End With
    End If

    Set rCurCell = Nothing

If Not (Intersect(Target, Rows(20), Columns(1)) Is Nothing) Then



End If
End Sub

Hvilket heller ikke virker; men det er formentligt ikke overraskende for mere erfarne end jeg.
Kan man ikke kombinere start af rækkeudvidelsesmakroen med tryk på enter efter afsluttet indtastning?

Lykkes det kommer sidste krav, nemlig at dette også skal fungere i et låst ark, så jeg kan hoppe fra åben celle til åben celle og alligevel få makroen til at køre.

For at deaktivere/aktivere arkbeskyttelsen automatisk, skal din kode se således ud :

Public Sub AutoFitMergedCellRowHeight()
    Dim iCurrentRowHeight As Single
    Dim iMergedCellRgWidth As Single
    Dim iActiveCellWidth As Single
    Dim iPossNewRowHeight As Single
    Dim rCurCell As Range
   
    ActiveSheet.Unprotect
   
    If ActiveCell.MergeCells Then
      With ActiveCell.MergeArea
            If .Rows.Count = 1 And .WrapText = True Then
                Application.ScreenUpdating = False
                .EntireRow.AutoFit
                iCurrentRowHeight = .RowHeight
                iActiveCellWidth = ActiveCell.ColumnWidth
                For Each rCurCell In Selection
                    iMergedCellRgWidth = rCurCell.ColumnWidth + iMergedCellRgWidth
                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = iMergedCellRgWidth
                .EntireRow.AutoFit
                iPossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = iActiveCellWidth
                .MergeCells = True
                .RowHeight = IIf(iCurrentRowHeight > iPossNewRowHeight, _
                iCurrentRowHeight, iPossNewRowHeight)
            End If
        End With
    End If

    ActiveSheet.Protect
       
    Set rCurCell = Nothing

End Sub