Příspěvky uživatele

Ještě jsem našel na webu toto, ale obávám se že je nějaký problém s formátem čísla na listě Data ve sloupci C.

S níže uvedeným by to mělo pracovat, ale nepracuje.

Sub Obaly()
Application.ScreenUpdating = False

Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("Data").Cells(Rows.Count, "C").End(xlUp).Row
lr2 = Sheets("Obaly").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
If Range("C" & r).Value2 = "8100" Or Range("C" & r).Value2 = "8200" Or Range("C" & r).Value2 = "8300" Then
Sheets("Data").Rows(lr2 + 1).EntireRow.Insert
Rows(r).Cut Destination:=Sheets("Obaly").Rows(lr2 + 1)
Rows(r).Delete
lr2 = Sheets("Obaly").Cells(Rows.Count, "A").End(xlUp).Row
End If
Next r
Application.ScreenUpdating = True
End Sub

Celá procedura ze sešitu
Sub Obaly()

Application.ScreenUpdating = False

Dim radek As Integer
Dim posledni As Long
posledni = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row

Sheets("Data").Select

For radek = 1 To posledni

If Range("C" & radek).Value2 = "8100" Or Range("C" & radek).Value2 = "8200" Or Range("C" & radek).Value2 = "8300" Then
Range("C" & radek).Offset(0, -2).Range("A1:Z1").Cut
Sheets("Obaly").Cells(65536, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll

ElseIf Range("C" & radek) <> 8100 Or Range("C" & radek) <> 8200 Or Range("C" & radek) <> 8300 Then

End If

Next

Application.ScreenUpdating = True
End Sub

Tak je špatně asi někde něco jiného.
Posílám přílohu i s procedurou, pokud by jsi se na to chtěl podívat.

Děkuji

Ahoj.

Snažím se vložit vyjmutý řádek z jednoho listu do prvního prázdného řádku na jiném listě.

Ale nějak se nedaří.

pro vkládání jsem se snažil použít toto, ale asi je něco špatně.

Prosím o pomoc, děkuji.

Sheets("Obaly").Cells(65536, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll

Elninoslov děkuji za pomoc, pracuje dle očekáváni.
Nicméně musím konstatovat že to co jsi napsal je pro mě Španělská vesnice a tak bych chtěl ještě požádat, zda by šlo nějak rozepsat?

Pokud ne, nic se neděje.
I tak děkuji.

Ahoj.
Potřeboval bych poradit jak přejít na další hledané číslo.

V sešitu dva listy "Dodáky" a "Neshoda".
V listě "Dodáky" je seznam čísel, které hledám v listě "Neshoda" a pokud toto číslo najdu tak číslo na listě "Neshoda" zůstane.

Pokud ho však nenajdu, tak smaže řádek. Takto prohledám celý list "Neshoda"

Po sem to zvládám.

Nevím ale jak přejít na další číslo v listě "Dodáky". Seznam hledaných čísel má vždy jiny počet čísel a jiná čísla.

Základní procedura:
Sub Neshoda()
Dim radek As Integer
Dim posledni As Long
posledni = Sheets("Neshoda").Cells(Rows.Count, 1).End(xlUp).Row

For radek = 2 To posledni

If Sheets("Neshoda").Range("A" & radek).Value2 = Sheets("Dodáky").Range("A1").Value2 Then

ElseIf Sheets("Neshoda").Range("A" & radek).Value2 <> Sheets("Dodáky").Range("A1").Value2 Then
Sheets("Neshoda").Range("A" & radek).EntireRow.Delete

End If
Next
End Sub

Pomůžete prosím někdo?
Děkuji

Šlape perfektně a během vteřiny mám rozesláno na všechny.
Nemusím nyní pracně tvořit cca 10 emailů a přikládat různě filtrované přílohy.
Děkuji všem.

Přikládám do přílohy, třeba by mohl někdo uplatnit.

Aby Vám fungovalo je potřeba zajistit:
•V kódu jsem vyznačil místa co je potřeba upravit na váš sešit či list.
•Zapsat řešitele do prvního sloupce (příjmení) a nikdy nesmí být pod záhlavím prázdný řádek.
•Nikdy nemazat datum pod tlačítkem, zde se zobrazuje aktuální datum.
•Zmáčknout tlačítko „Uložit a odeslat“.

Princip makra:
• Na základě příjmení vytvoří emailovou adresu do sloupce „Řešitel email“.
• Do sloupce „Odesláno na řešitele dne:“ zapíše aktuální datum.
• Tabulku uloží a odešle na všechny řešitele u kterých je ve sloupci „Odesláno na řešitele dne:“ datum dne, kdy odesíláte.
• Makro vytvoří email pro každého řešitele zvlášť.
• Řešitel dostane v příloze pouze řádky spojené s jeho jménem, nikdy tak nikdo neřeší úkoly ostatních a může se věnovat jen svým případům + můžete dopsat jakýkoli text do emailu

Výhody makra:
• jasně tak říkáte co a do kdy se po dotyčném chce a jak Vás má informovat o splnění
• máte v odeslané poště a zároveň v tabulce datum, kdy jste dotyčného informoval o zadání úkolu
• celé to trvá asi vteřinu
• odeslat můžete konkrétní odkazy jak na web či nějaké úložiště

Ahoj a děkuji všem za nápady a připomínky. Ani jsem s takovým zájmem nepočítal.

Ano používám to k rozesílání emailů ve firmě pomocí rozdělovníku, abych nemusel vytvářet pro každého email solo tak jsem chtěl využít VBA.

Elninoslov - to co jsi spáchal vypadá tak jak by mělo, ale zase nevím jak to mám zakomponovat do makra.

V příloze je tedy celé makro a tu tvou úpravu bych potřeboval dosadit sem.

Sub Dopln_email()
'Pokud ve sloupci "B" není email tak se = hodnota buňky ve sloupci "A" + "1csc.cz" bez diakritiky
Dim radek As Integer
Dim posledni As Long
posledni = Sheets("otevřené akce").Cells(Rows.Count, 1).End(xlUp).Row

For radek = 2 To posledni

Range("B" & radek).Value = Elninoslová uprava

'=REMOVE_DIACRITICS Range("A" & radek)" & "@1csc.cz"

Next

End Sub

Děkuji ještě jednou všem.

Ahoj.
Snažím se vytvořit emailovou adresu tím, že vezmu jméno z buňky ve sloupci "A" a přidám k ní konstantu třeba "seznam.cz".

Pokud budu mít tedy ve sloupci "A" jméno Novák, mělo by se ve sloupci "B" zobrazit "novak@seznam.cz"

Takto to vypadá dost jednoduše, ale nevím jak to spojit a jak se zbavit diakritiky a jak z toho udělat odkaz.

Snažil jsem se takto ale nejde to:
Range("B" & radek).Value = Range("A" & radek).Value & "seznam.cz"

Pomůže někdo prosím?
Děkuji

Ahoj.
Děkuji jak za uvedený kód tak uvedený postup pro asistentku.
Vše šlape skvěle.
Děkuji všem.

Finální podoba bude taková, že se v nočních hodinách spustí potřebný sešit, sáhne si do nově exportovaných dat z ERP a vygeneruje novou tabulku a rozešle na konkrétní příjemce formou emailu.

Ale to už jsem dělal tolikrát, že si s tím poradím.

Princip makra:
Z ERP vyexportovat nová data
Smazat stávající kont. tabulku
Vytvořit novou kont. tabulku
Pokud je v kont. tabulce nějaká osoba, tak pro každou osobu vytvořit list, překopírovat data spjatá s tímto jménem a vytvořit ještě souhrn

K výše uvedenému potřebuji makro.
Vzhledem k tomu, že se tato procedura dělá každý pátek a normálně trvá asistentce cca 2 hodiny je to ideální případ proč k tomuto vytvořit makro.

Vyzkoušel jsem poslední uvedený kód aktualizace, ale nic se nestalo.

Celé makro mám hotové, jediná věc která mi nejde je aby se kontingenční tabulka tvořila pouze z obsazených buněk a nevytvářela prázdný řádek.

I tak všem děkuji za ochotu a snahu.

Ahoj a děkuji za snahu pomoci mi.
V příloze tabulka s daty a tady zadání, snad je to srozumitelné.
Už jsem se to pokoušel obejít několika způsoby, ale vždy marně.

Snažil jsme se využít návod zde, ale návod je nedodělaný.
https://office.lasakovi.com/excel/VBA-kontingencni-tabulka/excel-vba-kontingencni-tabulka/

'nové kontingenční tabulka musí být umístěná v listě Celkem!R3C1
'nahráno přes záznam maker, potřebuji definovat oblast zdrojových dat tak, aby brala jen obsazené buňky z listu "Data"
'kód následně pokračuje a pokud je v kontingenční tabulce ve sloupci "A" buňka prázdná tak s tím mám problém
'toto potřebuji nahradit Data!R1C1:R800C44

Děkuji moc

Jde o to, že právě nevím jak

Ahoj.

Protože mám zdrojová dat kontingenční tabulky vždy o jiném počtu řádků, potřeboval bych nahradit SourceData:= "Data!R1C1:R800C44" něčím jako první až poslední řádek na listě "Data".

Sloupce jsou neměnné vždy jsou data od sloupce A po AR.

Mohl by se na to někdo prosím podívat, děkuji?

Perfektní, děkuji.

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje