Excel makro na kopirování a posun

[Zdenal z Brna]

Zdravím, můžete mě pomoct s tabulkou. Potřebuji sečíst A2:A=variabilní počet do bunky B2 a udělat kopii z A2:A=variabilní počet, do E2 a kopii tam nechat a pod ní dát z A2:A=variabilní počet další kopii. A ještě překopírovat součet z B2 do Listu2 do bunky E2 a posunout dolu a další kopie z Listu1 B2 až bude znovu sečítat A2:A=variabilní počet.
Uf, snad to jde pochopit co chci. Je to do malinkého obchodu kde se bude v A sčítat jednotlivý nakup, V E se bude uchovávat historie jednotlivých nakupu a v Listu 2 v E se bude archivovat kolik jednotlivý nákup stál Kč. Makro si upravím do jinýho souboru, potřebuji jenom nakopnout.Děkuji.

pokladna.xlsm

(182.19 KiB) Staženo 42 x

[Reklama]

[cmuch]

Tady je makro co by to mohlo splňovat.

Kód: Vybrat vše

Sub Kopie()
'
  Dim aSuma As Integer
  Dim iPocetKopie As Integer, iPocetNakupy As Integer
'
  With Sheets("List1")
    aSuma = .Range("B2").Value
    iPocetNakupy = .Cells(.Rows.Count, "A").End(xlUp).Row
    iPocetKopie = .Cells(.Rows.Count, "E").End(xlUp).Row
    .Range("E" & iPocetKopie + 1 & ":E" & iPocetKopie + iPocetNakupy - 1).Value = _
        .Range("a2:a" & iPocetNakupy).Value
    With Sheets("List2")
      .Range("E" & .Cells(.Rows.Count, "E").End(xlUp).Row + 1).Value = aSuma
    End With
    .Range("a2:a" & iPocetNakupy).ClearContents
   
    .Range("B2").Formula = "=Sum(A2:A50)"
  End With
End Sub


[Zdenal z Brna]

Je to perfektní,ještě malá prosba,aby se do List2 do E1 při spuštění makra přidalo datum za ty kopírované součty do sloupce F přidalo čas.Nebo když to nepůjde tak za ty kopírované součty do sloupce F přidalo datum a čas Jinak moooc děkuji. Ještě jsem zjistil, když spustím makro bez hodnoty List1 A2:A50 tak se mě odmazává po jednom řádku List1 B2.