Pro informace o výuce Excelu klikněte zde

Dotaz:

Jedno z možných řešení:

Sub KopievzorcuzPredchazejicihoRadku()

Dim r As Long, i As Long, pocR As Long, konR As Long

'první řádek výběru

pocR = Selection.Cells(1, 1).Row

'poslední řádek výběru

konR = Selection.Cells(Selection.Rows.Count, 1).Row



'Pokud je počáteční řádek = 1 tak ukonči

If pocR = 1 Then Exit Sub

'Vypnutí překreslování obrazovky a přepočtu

With Application

   .ScreenUpdating = False

   .Calculation = xlCalculationManual

End With

'vloží řádky

For r = pocR To konR

   Rows(r).Insert

Next r

'projde buňky od 1 do poslední neprázdné buňky v předcházejícím řádku

For i = 1 To Cells(pocR - 1, Columns.Count).End(xlToLeft).Column

   'pokud je vzorec

   If Cells(pocR - 1, i).HasFormula Then

      'použití AutoFill = rozšíření tažením za úchyt (tímto způsobem se dají řešit i posloupnosti)

      Cells(pocR - 1, i).AutoFill Destination:=Range(Cells(pocR - 1, i), Cells(konR, i)), Type:=xlFillDefault

   Else

      'pokud není vzorec zkopíruj pouze formáty

      Cells(pocR - 1, i).AutoFill Destination:=Range(Cells(pocR - 1, i), Cells(konR, i)), Type:=xlFillFormats

   End If

Next i

'zapnutí překreslování obrazovky a přepočtu

With Application

   .ScreenUpdating = True

   .Calculation = xlCalculationAutomatic

End With

End Sub