Makro - první prázdný řádek odshora Vyřešeno

[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

[Reklama]

[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

[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

[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.

[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.

[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??

[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