Příspěvky uživatele


< návrat zpět

Díky moc...ano, uznávám, že mohl, ale vůbec mě to nenapadlo...nebo spíš přepokládal jsem, že se budou vkládat řádky z jiného listu, že se budou opakovat...problém je, že si vymyslel šéf něco jiného a prostě to opakování a překopírování z jiného listu mi nestačí :-( doufám, že už si nic dalšího nevymyslí... :-( ještě jednou moc dík

Zdravím všechny, potřeboval bych poradit, věřím že pro Vás, s lehkým makrem….mám tabulku s určitými daty, to není podstatné….potřebuji makro, které bych přidal tlačítku, po jehož stisknutí by se mi objevil formulář které by se mě zeptal, kolik řádků chci přidat k tabulce, po zadání čísla (řekněme od 1 - 20) by na konec tabulky přidal (zkopíroval) mnou zvolený počet řádků které by měly vše stejné jako do této chvíle poslední řádek tabulky (podmíněné formátování, ověření dat, formát....) ale byly by bez dat kromě jednoho sloupce (sloupce I) ve kterém je vzorec který bych potřeboval aby se jako jediný ze zadaných dat kopíroval...díky všem za nápady a rady

kp57 to je přesně ono co jsem potřeboval. Jen jsem to ještě rozšířil na vvíc sloupců....jsi dobrej...díky moc

Ahoj lidi, potřeboval bych poradit s jednou maličkostí....mám excelovskou tabulku do které se mi pomocí vba při stisknutí tlačítka přidávají řádky (20)....potřebuju aby se mi do nově přidané řádky "zkopíroval" formát který je již použit v řádce nad první vloženou...pro přidání řádků používám tento kód...jak to upravit?

Sub VW()
Dim ws As Worksheet, wsD As Worksheet 'zkratky pro jednotlive listy
Dim iRow1 As Long
Dim dtDatum As Date

Set ws = Worksheets("vw")
Set wsD = Worksheets("-D")

dtDatum = CDate(Fix(Now()))

'posledni moznost si to rozmyslet
If vbNo = MsgBox("Chystáš se přidat položky do databáze projektu " & vbCrLf _
& "Opravdu to chceš udělat?", vbYesNo) Then Exit Sub

'jestli je na databazi nasazen filtr, tak ho oddelej
If wsD.FilterMode Then wsD.ShowAllData

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A2") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B2") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C2") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A3") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B3") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C3") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A4") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B4") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C4") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A5") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B5") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C5") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A6") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B6") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C6") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A7") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B7") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C7") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A8") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B8") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C8") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A9") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B9") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C9") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A10") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B10") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C10") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A11") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B11") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C11") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A12") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B12") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C12") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A13") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B13") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C13") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A14") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B14") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C14") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A15") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B15") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C15") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A16") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B16") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C16") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A17") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B17") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C17") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A18") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B18") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C18") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A19") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B19") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C19") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A20") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B20") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C20") 'Něco

'zjisti cislo posledniho radku v databazi
iRow1 = wsD.Range("A65000").End(xlUp).Row
iRow1 = iRow1 + 1 'budeme pripisovat na dalsi radek

'pripis novy radek do databaze
wsD.Cells(iRow1, "A") = ws.Range("A21") 'Projekt
wsD.Cells(iRow1, "B") = ws.Range("B21") 'Level
wsD.Cells(iRow1, "C") = ws.Range("C21") 'Něco


wsD.Activate

End Sub

Hav-Ran Díky, formulář mě také napadl, ale stejně si s tím nevím nějak rady...zkusím se podívat na soubor co jsi mi poslal a pokud to nepochopím, ozvu se....zatím díky

zdravím, mám vytvořenou tabulku pro zadávání projektů, vytvořené tlačítko s makrem pro přidání řádků a tlačítko pro setřídění podle názvu projektu....jsem schopný si i přidat tlačítko pro tisk ale v tom je problém. Jsem schopnej si přidat tlačítko pro tisk celého sešitu, ale potřeboval bych, aby při zmáčknutí tlačítka tisk se mi nabídly názvy projektů a po vybrání daného projektu se vytiskl jen časový plán zvoleného projektu a ne všechny. Nevím si s tím rady....děkuji za rady


Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

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

Aktivní diskuse