EXCEL Makro - kopirovani na novy list s posunem o jeden radek

[pablocz]

Dobry den,

Prosim o radu s makrem pro Excel

Mam udelane makro pro prenos dat na druhy list.
Toto makro spoustim pomoci tlacitka.
Z listu 1 - nacitam hodnoty z bunek A5 : G5, ktere prenasim do listu2, v bunce A1 (List1) urcuji na jaky radek listu 2 se ma kopirovat.
Neni to ale uplne idealni reseni.

Potreboval bych poradit jak udelat to, aby se pri kazdem stisku tlacitka prenasena data na List2
posunula automaticky o jeden radek (na novy prazdny radek), abych nemusel neustale menit hodnotu v bunce A1(list1).


Sub Prenos()

Dim Radek As Long

Radek = List2.Range("A1").Value

With List1
.Cells(Radek, 1) = List2.Range("A5").Value
.Cells(Radek, 2) = List2.Range("B5").Value
.Cells(Radek, 3) = List2.Range("C5").Value
.Cells(Radek, 4) = List2.Range("D5").Value
.Cells(Radek, 5) = List2.Range("E5").Value
.Cells(Radek, 6) = List2.Range("F5").Value
.Cells(Radek, 7) = List2.Range("g5").Value

End With
MsgBox "Provedeno", vbInformation, "Oznámení"
End Sub


Moc dekuji za pripadne napady.

Pavel

[Reklama]

[Grimm]

Kód: Vybrat vše

Option Explicit

Sub Prenos()

Dim Radek As Long

Radek = List2.Cells(Rows.Count, 1).End(xlUp).Row + 1

With List2
    .Cells(Radek, 1) = List1.Range("A5").Value
    .Cells(Radek, 2) = List1.Range("B5").Value
    .Cells(Radek, 3) = List1.Range("C5").Value
    .Cells(Radek, 4) = List1.Range("D5").Value
    .Cells(Radek, 5) = List1.Range("E5").Value
    .Cells(Radek, 6) = List1.Range("F5").Value
    .Cells(Radek, 7) = List1.Range("G5").Value
End With
MsgBox "Provedeno", vbInformation, "Oznámení"
End Sub

Sub Prenos2()
Dim Radek As Long

Radek = List2.Cells(Rows.Count, 1).End(xlUp).Row + 1
List1.Range("A5:G5").Copy List2.Cells(Radek, 1)
MsgBox "Provedeno", vbInformation, "Oznámení"
End Sub


Sub Prenos3()

Dim rngOblast As Range
Dim Radek As Long

Radek = List2.Cells(Rows.Count, 1).End(xlUp).Row + 1
Set rngOblast = List1.Range("A5:G5")

List2.Cells(Radek, 1).Resize(rngOblast.Rows.Count, rngOblast.Columns.Count).Cells.Value = rngOblast.Cells.Value
MsgBox "Provedeno", vbInformation, "Oznámení"
Set rngOblast = Nothing
End Sub


[pablocz]

Moc děkuji to je přesně ono

[chytilji]

Ahoj Grimme,
jde toto makro udělat i bez definice konkrétních řádků třeba jen na aktuálně označené buňky?

Děkuji za odpověď