Makro pro rozkopírování řádků

[Woodpecker]

Opět mám prosbu. Potřeboval bych makro pro rozkopírování řádků, viz malý vzorek. Jedno jsem tu sice našel, ale bohužel nevyhovuje mým potřebám. Používám MS Office 2003 v anglické verzi. Díky moc

[navstevnik]

V edotoru VBA (Alt+F11) vloz do standardniho modulu proceduru:

Kód: Vybrat vše

Option Explicit

Sub DoplnitRadky()
  Dim SBlk As Range, SClmn As Range, Cll As Range
  Dim CllVal As Variant
  On Error Resume Next
  Set SBlk = Application.InputBox("Vyber oblast bunek pro doplneni tazenim mysi" & vbCr _
      & "nebo vepsanim, napr.: A1:D3", Type:=8)
  If Err.Number <> 0 Then MsgBox "Nutno zadat oblast bunek, beh procedury ukoncen.": Exit Sub
  On Error GoTo 0
  With SBlk
    Set SClmn = .Resize(.Rows.Count, 1)
  End With
  For Each SClmn In SBlk.Columns
    CllVal = vbNullString
    For Each Cll In SClmn.Cells
      With Cll
        If .Value <> vbNullString Then CllVal = .Value Else .Value = CllVal
      End With
    Next Cll
  Next SClmn
  Set SBlk = Nothing
  Set SClmn = Nothing
  Set Cll = Nothing
End Sub

Po spusteni ( za nabidky Nastroje>... nebo klavesova zkratka nebo v editoru) vyzada vlozeni oblasti bunek pro doplneni.

[Woodpecker]

díky moc