Stránka 1 z 1
Makro - první prázdný řádek odshora
Napsal: 08 zář 2010 14:19
od Transmit
Zdravím,
znova se na vás obracím se žádostí o radu.
Tentokrát jde o to nastavit v makru "vyhledání" prvního prázdného řádku, kam se zkopíruje potřebná oblast.
Jednoduše, jde o archiv odeslané pošty, kdy v jednom listu je deset položek pošty k odeslání s adresami atd., který se denně obnovuje. Chtěl bych docílit vytvoření makro-tlačítka s jednoduchou funkcí "TISK", makro by ale zároveň mimo tisku těchto deset položek překopírovalo do předem vytvořeného listu, který by byl jako celkový přehled v minulosti odeslané pošty. V budoucnu by tak šlo v tomto listu dohledávat co, kdy a kam bylo posláno.
Jde mi tedy pouze o příkaz do Visual Basicu, který docílí vyhledání prvního prázdného v celkovém přehledu v minulosti odeslané pošty a počínaje tímto prázdným řádkem nakopíruje nově zapsanou odchozí poštu. Se vším ostastním si poradím, pouze ten příkaz na vyhledání prázdného řádku.
Díky moc za rady.
Štěpán
Re: Makro - první prázdný řádek odshora
Napsal: 08 zář 2010 17:24
od navstevnik
Jedno z moznych reseni:
Kód: Vybrat vše
Sub FrstEmptyDown()
' posledni bunka ve sloupci, hleda pocinaje A1 smerem k prvni volne
' minimalne A1:A2 musi byt neprazdne
Dim FrstR As Long, FrstCll As Range
With ActiveSheet
FrstR = .Range(.Range("A1"), .Range("A1").End(xlDown)).Rows.Count
Set FrstCll = .Range("A1").Offset(FrstR, 0)
End With
MsgBox FrstCll.Address
End Sub
Re: Makro - první prázdný řádek odshora
Napsal: 09 zář 2010 08:38
od Transmit
Díky za první ohlas, ale bohužel to nefunguje, makro je zavislý na buňce, ve které se v listu "Archiv odeslané pošty" pracovalo naposledy. Ve výsledku se tedy může text zkopírovat prakticky kamkoliv. Navíc pokud v listu ARCHIVU ODESLANÉ POŠTY "uměle" udržuju buňku A1 jako naposledy aktivní - pro udržení sloupce -, řádky se přepisují. Buňky A1 a A2 mám neprázdné.
S každým dalším spuštěním makra potřebuju vyhledat první volnou v A:A a počínají jí zkopírovat nově zapsanou poštu z vedlejšího listu "přepis".
Kód: Vybrat vše
Sub tisk_a_zaloha()
Sheets("přepis").Select
Range("A1:F10").Select
Selection.Copy
Sheets("ARCHIV ODESLANÉ POŠTY").Select
Dim FrstR As Long, FrstCll As Range
With ActiveSheet
FrstR = .Range(.Range("A1"), .Range("A1").End(xlDown)).Rows.Count
Set FrstCll = .Range("A1").Offset(FrstR, 0)
End With
MsgBox FrstCll.Address
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("arch").Select
End Sub
Re: Makro - první prázdný řádek odshora
Napsal: 09 zář 2010 09:24
od navstevnik
Obvykly problem: pozadavek je vytrzen z celkoveho konceptu( takze rada je prilis obecna nebo neodpovida vhodnemu reseni) nebo je nedostatecne definovan (pro radu pak plati totez).
Priloz soubor s demo ukazkou archivu (muze byt i prazdny, jen pripadne hlavicky) a listem prepis obsahujicim jeden (ci vice) polozek zpracovane posty urcene k prenosu do archivu, dopln upresnujici pozadavky.
Re: Makro - první prázdný řádek odshora
Napsal: 09 zář 2010 09:31
od Transmit
jasně, chápu, přikládám soubor
list "arch" je daný českou poštou, "přepis" - text je vzorcema předělán na řádky, "adresář" - oblast "odesílatelů" a "archiv odeslané pošty.
Sloupce v "přepisu" a "archiv odeslané pošty" mají stejnou posloupnost. Potřebuji makrem z "přepisu překopírovat buňky "jako hodnoty" do archivu. Aby bylo možné každým další spuštěním makra překopírovat nově zapsanou poštu z přepisu do archivu a vždy počínaje prvním volným řádkem odshora. Vytvoří se tak celkový přehled v minulosti odeslané pošty.
Díky.
Re: Makro - první prázdný řádek odshora Vyřešeno
Napsal: 09 zář 2010 10:53
od navstevnik
V priloze je sesit doplneny o potrebne procedury (pro prehlednost napsano modelove, jinak lze zjednodusit).
Neni osetreno opakovane preneseni jiz prenesenych zaznamu, pokud pozadujes, uved predstavu jak. Tisk??
Re: Makro - první prázdný řádek odshora
Napsal: 09 zář 2010 11:30
od Transmit
Skvělý, vše funguje..
proti opakovanýmu přenesení jsem do makra doplnil po vytištění vymazaní archu.
Díky moc.
// Označuji téma za vyřešené.
// mike007