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.5
Level 1.5
Příspěvky: 102
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

chytilji
nováček
Příspěvky: 6
Registrován: červenec 20
Pohlaví: Muž

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

Příspěvekod chytilji » 07 črc 2020 11:42

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ěď


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Makro - kopírování jednoho řádku na jiní list podle měsíců
    od lleennkkaa » 28 srp 2020 14:25 » v Kancelářské balíky
    3
    292
    od lleennkkaa
    01 zář 2020 12:02
  • 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
    1469
    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
    2077
    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
    883
    od guest
    28 pro 2019 20:50
  • Makro kopirovani do prazdne bunky
    od 8700 » 01 úno 2020 09:11 » v Kancelářské balíky
    0
    815
    od 8700
    01 úno 2020 09:11

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

Kdo je online

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