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

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

pablocz
nováček
Příspěvky: 2
Registrován: leden 20
Pohlaví: Muž

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

Příspěvekod pablocz » 09 led 2020 09:55

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
Uživatelský avatar
Grimm
Level 1
Level 1
Příspěvky: 86
Registrován: září 17
Pohlaví: Muž

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

Příspěvekod Grimm » 09 led 2020 21:27

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
nováček
Příspěvky: 2
Registrován: leden 20
Pohlaví: Muž

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

Příspěvekod pablocz » 14 led 2020 08:04

Moc děkuji to je přesně ono


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Excel VBA rozšíření automatického kopírování řádku na jiný list atd.
    od stenda » 01 říj 2019 15:01 » v Kancelářské balíky
    0
    1196
    od stenda
    01 říj 2019 15:01
  • EXCEL kopírování na jiný list na číslo řádku dle buňky
    od Klásek » 03 říj 2019 16:44 » v Kancelářské balíky
    5
    1309
    od Klásek
    07 říj 2019 13:43
  • Kopírování na nový list podle podmínky
    od Flea2014 » 28 pro 2019 11:18 » v Kancelářské balíky
    1
    217
    od guest
    28 pro 2019 20:50
  • Prosím opomoc VBA Kopírování vybraných buněk na druhý list
    od upai » 03 bře 2019 11:26 » v Programování a tvorba webu
    4
    1518
    od karlos64
    11 bře 2019 07:55
  • Excel vyhodnocení dat - první a poslední řádek dne
    od MK_Vs » 02 črc 2019 20:24 » v Kancelářské balíky
    9
    1615
    od MePExG
    04 črc 2019 12:27

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot] a 2 hosti