Kopírování vybraných buněk makrem na nový řádek jiného listu
Napsal: 20 pro 2012 00:33
Ahoj borci,
celý den se snažím dát do kupy makro, které je pro vás určitě jednoduché, ale jsem už v koncích.
Mám složitou tabulku ze které jsem vybral (a lehce upravil) dva listy. Do jednoho vypisuji a vybírám z rozevíracích seznamů údaje.
Všechny tyto údaje (z barevných polí) potřebuji přepsat do řádku na listu "zapsáno" a to při každém kliknutí na "zapiš".
Má to ale dva háčky:
- při každém zápisu se musí zapsat nová hodnota do první buňky na listu "zapsáno" tedy "číslo řádku"
- pokud bude některé z polí prázdné, zapíše se do prázdné buňky velké X (nebo něco zástupného - pole nesmí zůstat prázdné)
- no a na konci by to mělo tato pole vymazat, ale to už dokážu sám.
Zasekl jsem se hned na začátku. Chtěl jsem použít jednoduché makro, které najde první prázdnou buňku a zkopíruje první pole, dá "šipku vpravo" a tak dál:
Bohužel, jak je jasné, nefunguje to :(
Prosím vás o pomoc.
celý den se snažím dát do kupy makro, které je pro vás určitě jednoduché, ale jsem už v koncích.
Mám složitou tabulku ze které jsem vybral (a lehce upravil) dva listy. Do jednoho vypisuji a vybírám z rozevíracích seznamů údaje.
Všechny tyto údaje (z barevných polí) potřebuji přepsat do řádku na listu "zapsáno" a to při každém kliknutí na "zapiš".
Má to ale dva háčky:
- při každém zápisu se musí zapsat nová hodnota do první buňky na listu "zapsáno" tedy "číslo řádku"
- pokud bude některé z polí prázdné, zapíše se do prázdné buňky velké X (nebo něco zástupného - pole nesmí zůstat prázdné)
- no a na konci by to mělo tato pole vymazat, ale to už dokážu sám.
Zasekl jsem se hned na začátku. Chtěl jsem použít jednoduché makro, které najde první prázdnou buňku a zkopíruje první pole, dá "šipku vpravo" a tak dál:
Kód: Vybrat vše
Sub zapis()
'
' zapis Makro
'
'
Sheets("Zadávání").Select
Range("E3:H4").Select
Selection.Copy
Sheets("zapsáno").Select
a = Cells(Columns.Count, 1).End(xlUp).Row + 1
Cells(a, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.SendKeys ("{RIGHT}")
Sheets("Zadávání").Select
Range("K3:N4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("zapsáno").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.SendKeys ("{RIGHT}")
Sheets("Zadávání").Select
Range("Q3:T4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("zapsáno").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.SendKeys ("{RIGHT}")
Sheets("Zadávání").Select
Range("E5:H6").Select
Application.CutCopyMode = False
Selection.Copy
Range("F37:F38").Select
Sheets("zapsáno").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.SendKeys ("{RIGHT}")
End Sub
Bohužel, jak je jasné, nefunguje to :(
Prosím vás o pomoc.
