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ž
Stav:
Offline

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 2
Level 2
Příspěvky: 162
Registrován: září 17
Pohlaví: Muž
Stav:
Offline

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ž
Stav:
Offline

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ž
Stav:
Offline

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
  • Excel - filtr hyperlinku na druhý list Příloha(y)
    od mikiracan » 06 čer 2023 11:49 » v Kancelářské balíky
    2
    2438
    od mikiracan Zobrazit poslední příspěvek
    18 srp 2023 10:17
  • Jeden internet - dva byty
    od Myerina » 08 zář 2023 10:58 » v Sítě - hardware
    14
    2436
    od Myerina Zobrazit poslední příspěvek
    08 zář 2023 13:16
  • 2 prípojky optického internetu na jeden dom
    od krakenus600 » 15 srp 2023 22:16 » v Vše ostatní (inet)
    12
    4515
    od RIKI22 Zobrazit poslední příspěvek
    17 srp 2023 20:47
  • Optiplex nebere jeden 3TB disk
    od roninn » 09 srp 2023 18:03 » v Problémy s hardwarem
    2
    696
    od roninn Zobrazit poslední příspěvek
    09 srp 2023 19:24
  • Kopírování řádků s funkcí když Příloha(y)
    od Martyn20 » 20 črc 2023 16:50 » v Kancelářské balíky
    3
    1791
    od Melvidor Zobrazit poslední příspěvek
    21 črc 2023 08:41

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

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 11 hostů