Buď propojený obrázek, nebo makro.citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: kopirovanie a prilepenie vydidtelnych riadkov
MS Excel
Téma: kopirovanie a prilepenie vydidtelnych riadkov 
Zaslal/a 2.12.2014 20:01
Ahojte, mam taku otazocku ako by som mohol kopirovat a prilepit na iny sheet v exceli iba vyditelne riadky? Da sa to nejak? dik za pomoc
Např:Sub Kopirovani()
Dim rdR As Long, rdLast As Long, rdW As Long, slR As Byte
slR = 10 'posledni sl. oblasti Listu1
rdW = 0 'radek zapisu do List2
With Sheets("List1")
'posledni rd. oblasti Listu1 v sl. 1
rdLast = .Cells(Rows.Count, 1).End(xlUp).Row
For rdR = 1 To rdLast
If Not .Rows(rdR).Hidden Then
rdW = rdW + 1
Range(.Cells(rdR, 1), .Cells(rdR, slR)).Copy Sheets("List2").Cells(rdW, 1)
End If
Next rdR
End With
End Sub
citovat
Dim rdR As Long, rdLast As Long, rdW As Long, slR As Byte
slR = 10 'posledni sl. oblasti Listu1
rdW = 0 'radek zapisu do List2
With Sheets("List1")
'posledni rd. oblasti Listu1 v sl. 1
rdLast = .Cells(Rows.Count, 1).End(xlUp).Row
For rdR = 1 To rdLast
If Not .Rows(rdR).Hidden Then
rdW = rdW + 1
Range(.Cells(rdR, 1), .Cells(rdR, slR)).Copy Sheets("List2").Cells(rdW, 1)
End If
Next rdR
End With
End Sub
citovat
(3.12.2014 19:55)#022653
Predsa by som mal este jednu otazku ako by sa to dalo osefovat aby po kopirovani a prilepeni na novy sheet zachoval sirky riadkov a stlpcov
MOJA uvaha je ze by som tam mal nejak zakonponovat xlPasteColumnWidths je to mozne?citovat
MOJA uvaha je ze by som tam mal nejak zakonponovat xlPasteColumnWidths je to mozne?citovat
Samozřejmě, nic ti v tom nebrání.
Sub Kopirovani()
Dim rdF As Byte, rdR As Long, rdLast As Long, rdW As Long, slR As Byte
slR = 10 'posledni sl. oblasti Listu1
rdW = 0 'rd. zapisu do List2
With Sheets("List1")
Range(.Cells(1, 1), .Cells(1, slR)).Copy 'sirka sloupcu
Sheets("List2").Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
rdLast = .Cells(Rows.Count, 1).End(xlUp).Row 'posledni rd. oblasti Listu1
For rdR = 1 To rdLast
If Not .Rows(rdR).Hidden Then
rdW = rdW + 1
Range(.Cells(rdR, 1), .Cells(rdR, slR)).Copy Sheets("List2").Cells(rdW, 1)
Sheets("List2").Rows(rdW).RowHeight = .Rows(rdR).RowHeight
End If
Next rdR
End With
End Sub
citovat
Sub Kopirovani()
Dim rdF As Byte, rdR As Long, rdLast As Long, rdW As Long, slR As Byte
slR = 10 'posledni sl. oblasti Listu1
rdW = 0 'rd. zapisu do List2
With Sheets("List1")
Range(.Cells(1, 1), .Cells(1, slR)).Copy 'sirka sloupcu
Sheets("List2").Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
rdLast = .Cells(Rows.Count, 1).End(xlUp).Row 'posledni rd. oblasti Listu1
For rdR = 1 To rdLast
If Not .Rows(rdR).Hidden Then
rdW = rdW + 1
Range(.Cells(rdR, 1), .Cells(rdR, slR)).Copy Sheets("List2").Cells(rdW, 1)
Sheets("List2").Rows(rdW).RowHeight = .Rows(rdR).RowHeight
End If
Next rdR
End With
End Sub
citovat
(4.12.2014 0:20)#022656
Nevím jestli je makro nutné.
Vybrat oblast (pokud je to jeden blok, tak třeba ctrl-a)
Vybrat viditelné (alt-`) - levá uvozovka, nebo kliknutím na ikonku výběru viditelných (mám ji na liště - přizpůsobit panel nástrojů, příkazy mimo pás karet, vybrat viditelné buňky) nebo některým z dalších způsobů.
ctrl-c, ctrl-v (nebo ctrl-alt-v nebo pravý klik ...)citovat
Vybrat oblast (pokud je to jeden blok, tak třeba ctrl-a)
Vybrat viditelné (alt-`) - levá uvozovka, nebo kliknutím na ikonku výběru viditelných (mám ji na liště - přizpůsobit panel nástrojů, příkazy mimo pás karet, vybrat viditelné buňky) nebo některým z dalších způsobů.
ctrl-c, ctrl-v (nebo ctrl-alt-v nebo pravý klik ...)citovat
(4.12.2014 19:34)#022673
Dakuejm funguje mnoo musim to mat s makrom pretoze cely dokument by mal fungovat tak ze, ked zatlacim tlacitko prebehne pridanie noveho sheetu:
Sheets.Add After:=ActiveSheet
-nazov sheetu je tahany zo vzoroveho sheetu :
B = Sheets("vzor").Range("B18").Value
A = Sheets("vzor").Range("B4").Value
C = Sheets("vzor").Range("D7").Text
ActiveSheet.Name = B & "-TR-" & A & "-" & C
Dal by sa kod co si mi poslal ten co kopiruje aj format stlpcou skombinovat s kodom co som poslal ja? SOm ztoho lama .. poviem pravdu skusal som moznosti ale nejak to psolu nejde .. Dik za rady a cascitovat
Sheets.Add After:=ActiveSheet
-nazov sheetu je tahany zo vzoroveho sheetu :
B = Sheets("vzor").Range("B18").Value
A = Sheets("vzor").Range("B4").Value
C = Sheets("vzor").Range("D7").Text
ActiveSheet.Name = B & "-TR-" & A & "-" & C
Dal by sa kod co si mi poslal ten co kopiruje aj format stlpcou skombinovat s kodom co som poslal ja? SOm ztoho lama .. poviem pravdu skusal som moznosti ale nejak to psolu nejde .. Dik za rady a cascitovat
Ty se vůbec nesnažíš!Dim Sh As Worksheet
Set Sh = Sheets.Add(After:=ActiveSheet)
Sh.Name = B & "-TR-" & A & "-" & C
''tady dej kód - Kopirovani
''v Kódu Kopirovani změnit
''Sheets("List1") na Sheets("vzor")
''Sheets("List2") na Sh
Set Sh = Nothing
a je to.
PS
Ten Hyperlink si vlož přes záznamník, to ti napoví. Zbytek snad už zvládneš. Snaž se!citovat
Set Sh = Sheets.Add(After:=ActiveSheet)
Sh.Name = B & "-TR-" & A & "-" & C
''tady dej kód - Kopirovani
''v Kódu Kopirovani změnit
''Sheets("List1") na Sheets("vzor")
''Sheets("List2") na Sh
Set Sh = Nothing
a je to.
PS
Ten Hyperlink si vlož přes záznamník, to ti napoví. Zbytek snad už zvládneš. Snaž se!citovat
(5.12.2014 17:32)#022680
Snazim :) Podorali sa mi vyriesit to kopirovanie sice troska zlozitejsie jak si mi napisal ty ale funguje to, upravil som kod co si mi poslal predtym
Dim A As Long
Dim B As Date
Dim C As String
B = Sheets("vzor").Range("B18").Value 'datum a cas zadania
A = Sheets("vzor").Range("B4").Value 'ciso testingu
C = Sheets("vzor").Range("D7").Text 'segment
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = B & "-TR-" & A & "-" & C
Dim rdF As Byte, rdR As Long, rdLast As Long, rdW As Long, slR As Byte
slR = 10
rdW = 0
With Sheets("vzor")
Range(.Cells(1, 1), .Cells(1, slR)).Copy
ActiveSheet.Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
rdLast = .Cells(Rows.Count, 1).End(xlUp).Row
For rdR = 1 To rdLast
If Not .Rows(rdR).Hidden Then
rdW = rdW + 1
Range(.Cells(rdR, 1), .Cells(rdR, slR)).Copy ActiveSheet.Cells(rdW, 1)
ActiveSheet.Rows(rdW).RowHeight = .Rows(rdR).RowHeight
End If
Next rdR
End With
End Sub
Cez zaznamik som to vkladal ... moja predstava je taka ze bude to chet deklarovat premenne ktore potom zakonponujem do nazvu pri vytvarani hyperlinku ... pravdepodobne premenne typu string ibaze co som ksusal tak nefunguje dik za raducitovat
Dim A As Long
Dim B As Date
Dim C As String
B = Sheets("vzor").Range("B18").Value 'datum a cas zadania
A = Sheets("vzor").Range("B4").Value 'ciso testingu
C = Sheets("vzor").Range("D7").Text 'segment
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = B & "-TR-" & A & "-" & C
Dim rdF As Byte, rdR As Long, rdLast As Long, rdW As Long, slR As Byte
slR = 10
rdW = 0
With Sheets("vzor")
Range(.Cells(1, 1), .Cells(1, slR)).Copy
ActiveSheet.Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
rdLast = .Cells(Rows.Count, 1).End(xlUp).Row
For rdR = 1 To rdLast
If Not .Rows(rdR).Hidden Then
rdW = rdW + 1
Range(.Cells(rdR, 1), .Cells(rdR, slR)).Copy ActiveSheet.Cells(rdW, 1)
ActiveSheet.Rows(rdW).RowHeight = .Rows(rdR).RowHeight
End If
Next rdR
End With
End Sub
Cez zaznamik som to vkladal ... moja predstava je taka ze bude to chet deklarovat premenne ktore potom zakonponujem do nazvu pri vytvarani hyperlinku ... pravdepodobne premenne typu string ibaze co som ksusal tak nefunguje dik za raducitovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
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.
RSS nejnovější články