Stránka 1 z 2
VBA makro- kopirovani s podminkou
Napsal: 12 úno 2013 16:09
od Axinka
Ahoj vsem,
muzete mi nekdo poradit jak sestavit v excelu makro na kopirovani vsech radku z VZOR do noveho listu s podminkou, ze hodnota ve 4. sloupci musi byt >0?
Range (B3:G45) z listu VZOR do noveho listu.
Predem moc diky za pomoc
Axi
Re: VBA makro- kopirovani s podminkou
Napsal: 12 úno 2013 17:24
od cmuch
Vítej na PC-Help
Makro zkopíruje hodnoty z řádku na nový list.
Alt+F8 - makro "Kopie"
Re: VBA makro- kopirovani s podminkou
Napsal: 12 úno 2013 19:50
od Axinka
Ahoj a moc díky to pomohlo,
ještě ale řeším zapeklitou věc- v původní tabulce je SUBTOTAL na mezisoučty a ten bych potřebovala i když hodnoty přes makro s podmínkou překopíruji do dalšího listu ALE ,,kategorie,, pod které subtotal potřebuji vložit nejsou nijak systematicky rozlišené (jenom barvou ve sloupci A a ta je taky ,,náhodná,,). Dá se toto nějak vyřešit? tzn. jak zadat kdy a kam se má subtotal vložit, pokud bych to řešila makrem?
Předem moc díky za pomoc
Axi
Re: VBA makro- kopirovani s podminkou
Napsal: 12 úno 2013 20:04
od cmuch
Co třeba takto,
nahraď část For tímto
Kód: Vybrat vše
For rprac = 3 To radek
'Najít první volný řádek na listu sl B a vlozit
radekn = Sheets(newshnm).Cells(Rows.Count, 2).End(xlUp).Row + 1
' Proved kdyz je zmena ve sloupci
If Sheets(pracsh).Cells(rprac, slprac).Value > 0 Then
'vlozit
Worksheets(pracsh).Rows(rprac).Copy
Worksheets(newshnm).Rows(radekn & ":" & radekn).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select
ElseIf Sheets(pracsh).Cells(rprac, 2).Value = "Subtotal" Then
Sheets(newshnm).Cells(radekn, 2).Value = Sheets(pracsh).Cells(rprac, 2).Value
End If
Next rprac
Re: VBA makro- kopirovani s podminkou
Napsal: 17 úno 2013 20:24
od Axinka
Ahoj,
diky moc, to funguje. Jeste resim posledni problem- jak nastavit, aby kazdy subtotal ve sloupci G zobrazil mezisoucet polozek v radsich ,,nad subtotal,, a zaroven mezi podlednim subtotalem.
Diky za radu
Re: VBA makro- kopirovani s podminkou
Napsal: 18 úno 2013 07:28
od cmuch
Nahraď to původní makro tímto:
Kód: Vybrat vše
Sub Kopie()
Dim pracsh, slprac, newshnm As Variant
Dim rprac, radek, radekn As Long
Dim startRow As Integer
Dim startCell As Range, endCell As Range
'Tichy rezim
Application.ScreenUpdating = False
'Nastaveni
pracsh = "VZOR" ' Název Listu ze ktereho se ma kopirovat
slprac = 4 ' Sloupec co se má kontrolvat , 1=A
startRow = 2 ' radek od ktereho se bude pocitat
'Najít posledni øádek na listu ve sl B
radek = Sheets(pracsh).Cells(Rows.Count, 2).End(xlUp).Row
' vytvor list a zjisti jmeno
Sheets.Add After:=Sheets(Sheets.Count)
newshnm = ActiveSheet.Name
For rprac = 3 To radek
'Najít první volný øádek na listu sl B a vlozit
radekn = Sheets(newshnm).Cells(Rows.Count, 2).End(xlUp).Row + 1
' Proved kdyz je zmena ve sloupci
If Sheets(pracsh).Cells(rprac, slprac).Value > 0 Then
'vlozit
Worksheets(pracsh).Rows(rprac).Copy
Worksheets(newshnm).Rows(radekn & ":" & radekn).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select
ElseIf Sheets(pracsh).Cells(rprac, 2).Value = "Subtotal" Then
' vepsani subtotal
Sheets(newshnm).Cells(radekn, 2).Value = Sheets(pracsh).Cells(rprac, 2).Value
' soucet bunek
Set startCell = Sheets(newshnm).Cells(startRow, 7)
Set endCell = Sheets(newshnm).Cells(radekn, 7).Offset(-1, 0)
Sheets(newshnm).Cells(radekn, 7).Formula = "=SUM(" & startCell.Address & ":" & endCell.Address & ")"
startRow = radekn + 1
End If
Next rprac
Sheets(pracsh).Select
Application.CutCopyMode = False
Range("A1").Select
'Tichy rezim vypnout
Application.ScreenUpdating = True
Set startCell = Nothing
Set endCell = Nothing
End Sub
Re: VBA makro- kopirovani s podminkou
Napsal: 19 úno 2013 23:16
od Axinka
Ahoj, diky moc. Pracovala jsem s tim dal a nejak se zamotavam. Myslim, ze se cely muj problem da vyresit urcite nejak lip, nez myslim. Co konkretne chci udelat- komplet cela tabulka v listu VZOR se ma nakopirovat na novy list (vcetne formatu a vzorcu v kazde bunce jak je v puvodnim VZOR) a v nove tabulce na List 1 potrebuji jenom odstranit radky, ktere budou mit ve sloupci 4 hodnotu rovne= 0.
Da se to vyresit jednodussim makrem? Ja uz se v tom totiz zamotala uplne.
Moc diky za pomoc
Re: VBA makro- kopirovani s podminkou
Napsal: 21 úno 2013 21:21
od cmuch
Ještě odladím trochu makro, ale až o víkendu.
Pokud někdo neodpoví dříve.
Re: VBA makro- kopirovani s podminkou
Napsal: 21 úno 2013 22:03
od Axinka
Diky moc!
Re: VBA makro- kopirovani s podminkou
Napsal: 22 úno 2013 13:18
od Axinka
Ahoj, jenom jsem chtela doplnit info, ze v tom sesitu VZOR co jsem pripojila jako posledni se na konci tabulky nachazeji radky se soucty (ktere jsem tam predim nemela), pak jsou tam radky na poznamky, ktere bych taky potrebovala kopirovat.
Moc diky predem milionkrat
Axi
Re: VBA makro- kopirovani s podminkou
Napsal: 24 úno 2013 13:15
od cmuch
Upravil jsem vzorec pro subtotaly a předělal makro.
Koukni na to.
// upraveno makro (skrývá řádky kde je subtotal 0kč)
Re: VBA makro- kopirovani s podminkou
Napsal: 24 úno 2013 16:49
od Axinka
Perfektni, muzes pls uz jenom nastavit,aby se pri kopirovani vymazaly ty ,,Subtotal,, ktere maji ve sloupci hodnotu 0kč?
Diky