< návrat zpět

MS Excel

Téma: CUTCOPY - řádek na sloupec rss

Zaslal/a BigHelpNeeded 18.7.2017 14:42

Dobrý den, potřeboval bych, aby mi toto VBA nedávalo zálohu do řádku, ale do sloupce stavělo pod sebe, věděl by někdo zkušený poradit? Dost by mi to pomohlo s přehledností :)

Sub Presun()
Dim Stlp As Integer
If WorksheetFunction.CountIf(Range("A80:K89"), "<>") > 0 Then
Application.ScreenUpdating = False
With Worksheets("Výstup")
Stlp = .Cells(1, Columns.Count).End(xlToLeft).Column + 3
Range("A80:K89").Cut .Columns(Stlp).Resize(, 10)

End With
Application.CutCopyMode = False
Application.ScreenUpdating = True

End If
Application.CutCopyMode = False
Call Makro4
End Sub

Zaslat odpověď >
Pavlus(18.7.2017 18:30)#036914
avatar
Chtělo by to konkrétní ukázku toho, co přesně má dané makro dělat...
P.citovat
elninoslov(18.7.2017 18:40)#036915
elninoslov
Len poznámka z mobilu. Stĺpcov v rozsahu A:K je 11, Vy robíte potom Resize na 10. Skutočne Vám to funguje správne? Samozrejme potrebu prílohy spomínal Pavlus...citovat
Dejwing(19.7.2017 9:02)#036919
avatar
Konkrétně to spouští jiné makro přes call, takže v tomto případě je nutné vstoupit do makra a spustit. Jde o to, že bych to potřeboval vypisovat po sloupcích a to přesně ve sloupce A-K, aby se to pak dalo hezky na A4 vytisknout, pokud generuji do řádku... tak mi to přidělává spoustu práce. Elninoslov, děkuji za upozornění, chybu jsem si opravil.
Příloha: zip36919_misto-do-radku-zapis-do-sloupce.zip (15kB, staženo 28x)
citovat
Dejwing(19.7.2017 9:04)#036920
avatar
Ideální by bylo, kdyby při kopírování se kopírovaly jen hodnoty v případě, že by tam byl vzorec :))citovat
elninoslov(20.7.2017 19:06)#036941
elninoslov
Hmm ... aj tak neviem, čo presne chcete dosiahnuť ... fakt nerozumiem ... to bude asi prepečenou gebuľou od slnka ... :)citovat
Dejwing(21.7.2017 11:11)#036944
avatar
No ono je těžké vysvětlit dostatečně myšlenku, ale v tomto excelovském návodu jsem udělal naprosto jednoznačný návod i s popisem, snad se v tom tentokráte bude dát orientovat. Věřím že ano, je tam i list s požadovaným výstupem, jak bych si přál, aby výstup vypadal. Makro se ovládá pomocí pole L1, kde se zadá hotovo, neumím definovat spuštění makra a smazání pole, tak to řeším přes pomocná pole M1 a M2 :)
Příloha: zip36944_misto-do-radku-zapis-do-sloupce-navod.zip (22kB, staženo 23x)
citovat
xlnc(21.7.2017 11:42)#036946
avatar
Zaměňte komplet to vaše v modulu listu za:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngOblast As Range

Application.ScreenUpdating = False

If (Target.Address(False, False) = "L1") And (Target.Value = "Hotovo") Then

Set rngOblast = Range("A1:K10")

With Worksheets("Požadovaný výstup")

rngOblast.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(2, 0)

End With

End If

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Subcitovat
Dejwing(21.7.2017 12:41)#036949
avatar

xlnc napsal/a:

Zaměňte komplet to vaše v modulu listu za:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngOblast As Range

Application.ScreenUpdating = False

If (Target.Address(False, False) = "L1") And (Target.Value = "Hotovo") Then

Set rngOblast = Range("A1:K10")

With Worksheets("Požadovaný výstup")

rngOblast.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(2, 0)

End With

End If

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub


Skvělé! Funguje to parádně, šlo by ještě upravit, aby buňky nekopírovalo vzorce ale jako hodnoty? :)citovat

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