< návrat zpět

MS Excel

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

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
avatar
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
avatar
Ďakujem, funguje perfektne.citovat
dream2003(13.2.2015 20:08)#023629
avatar
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
avatar
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)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje