• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Makro - problém s kopírovaním údajov

Zaslal/a Marek_Banas 13.2.2015 13:49

Dobrý deň, nižšie popisujem problém, ďakujem za odpovede.

Cieľom je aby som zapísal údaje do jedného zošita (nazval som ho "hlavná"), stlačím v ňom tlačidlo pre zápis a údaje sa nakopírujú do druhého zošita ("zdrojova_tabulka") do jedného riadku. Následne ďalší zápis sa skopíruje do riadku pod ním. Problém je, že musím mať v cieľovom zošite prvé dva riadky predvyplnené, inak mi hádže chybu v makre na riadku ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate. Zároveň sa mi označí bunka na spodku zošita.

Pripájam kód:
Sheets("hlavná").Select
Range("B1:B9").Select
Selection.Copy
Sheets("zdrojova_tabulka").Select
Range("C1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Selection.End(xlToLeft).Select

Zaslat odpověď >

---

Jirka78(13.2.2015 14:38)#023627

Dobrý den, možné řešení je například:

Sheets("hlavná").Select
Range("B1:B9").Copy
Sheets("zdrojova_tabulka").Select
Range("C65536").Select
Selection.End(xlUp).Select
If ActiveCell.Value <> "" Then
ActiveCell.Offset(1, 0).Activate
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Selection.End(xlToLeft).Selectcitovat

Marek_Banas(13.2.2015 14:59)#023628

Ďakujem, funguje perfektne.citovat

dream2003(13.2.2015 20:08)#023629

Dobrý den,

jde to i jednodušeji

Sub Makro1()
Dim lastrow As Long
lastrow = Sheets("zdrojova_tabulka").Range("c65536").End(xlUp).Row + 1
Sheets("hlavná").Range("B1:B9").Copy
Sheets("zdrojova_tabulka").Range("d" & lastrow).PasteSpecial Paste:=xlPasteValues
Selection.End(xlToLeft).Select 'to netuším proč tam je
End Subcitovat

Jirka78(14.2.2015 19:54)#023633

Dobrý den, dovolil jsem si opravit makro kolegy Dream2003, jenže makro má stejně tu nevýhodu, že se data vkládají až od druhého řádku. Proto jsem tam měl ten if.

Sub Makro1()
Dim lastrow As Long
lastrow = Sheets("zdrojova_tabulka").Range("c65536").End(xlUp).Row + 1
Sheets("hlavná").Range("B1:B9").Copy
Sheets("zdrojova_tabulka").Range("c" & lastrow).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Selection.End(xlToLeft).Select 'to netuším proč tam je
End Subcitovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse