Makro VBA -kopírování do první prázdné buňky Vyřešeno

[castielo]

Zdravím všechny,
hodně jsem googloval, ale odpověď, která by řešila můj problém jsem nenašel, proto se obracím na Vás.
Píšu jednoduché makro, které má za úkol zkopírovat buňky z jednoho listu a vložit do druhého. Ve druhém listu je seznam a já chci, aby se data z prvního sešitu ukládala do druhého listu postupně (aby tvořili seznam, tj. vložení do první prázdné buňky).
Tady je můj kód

Sub faktura_vydana()
Sheets("FAKTURA").Activate 'vybere listu faktura
Range("J15").Select
Selection.Copy 'vybere buňku a zkopíruje
Sheets("VYDANÉ FAKTURY").Activate 'vybere list vydané faktury
xx xxxxx 'zde by měl být příkaz na vložení dat do prvního volného řádku ve sloupci

End Sub

Za jakoukoli radu/odkaz předem velice děkuji!

[Reklama]

[Uziv00]

Smyčka Do Until s testováním, zda je buňka prázdná a s inkrementací čísla řádku.

[lubo.]

Když už jsi to celé naklepal záznamíkem, proč jsi nedodal pár klapek(ctrl šipka)? Activate, select je zbytečný, jen zpomaluje makro
Kopíruje od A1

Kód: Vybrat vše

Sub faktura_vydana()
Dim rCil As Range
   ' vybere listu faktura, vybere buňku a zkopíruje
   Set rCil = Sheets("VYDANÉ FAKTURY").Range("a1")          ' první buňku neznám
   If Not IsEmpty(rCil) Then                                               ' testování aby to neodskočilo na poslední řádek listu
      If Not IsEmpty(rCil.Offset(1, 0)) Then
          Set rCil = rCil.End(xlDown).Offset(1, 0)
      End If
   End If
   Sheets("FAKTURA").Range("J15").Copy Destination:=rCil
   Set rCil = Nothing
End Sub


[castielo]

Kód jsem nedělal přes nahrávání, vba se učím ne moc dlouho a proto to vypadá, jak to vypadá. Ale díky za připomínku, nebudu už používat activate.

Makro co jsi napsal funguje, ale ne přesně jak jsem si představoval. Když si k němu přidám "čudlík" tak chci, aby to po zmáčknutí to hodnotu zkopírovalo do druhého listu (což tvůj kód udělá), ale když pak zadám ho buňky v listu1(FAKTURA) novou hodnotu a zmáčknu "čudlík", tak se hodnota v listu2(VYDANÉ FAKTURY) přepíše, ale já potřebuju, aby se zapsala pod to, aby tvořila seznam.

[cmuch]

Zkus nahradit řádek

Kód: Vybrat vše

Set rCil = Sheets("VYDANÉ FAKTURY").Range("a1")

tímto

Kód: Vybrat vše

Set rCil = Sheets("VYDANÉ FAKTURY").Range("a" & Sheets("VYDANÉ FAKTURY").Cells(Rows.Count, 1).End(xlUp).Row + 1)

[lubo.]

Opraveno. Hledá první prázdnou buňku za zadanou, není ošetřen případ, kdy je celý sloupce vyplněn.

Kód: Vybrat vše

Sub faktura_vydana()
Dim rCil As Range
   ' vybere listu faktura, vybere buňku a zkopíruje
   Set rCil = Sheets("VYDANÉ FAKTURY").Range("a1")          ' první buňku neznám
   If Not IsEmpty(rCil) Then                                               ' testování aby to neodskočilo na poslední řádek listu
      If Not IsEmpty(rCil.Offset(1, 0)) Then
          Set rCil = rCil.End(xlDown)
      End If
      Set rCil = rCil.Offset(1, 0)
   End If
   Sheets("FAKTURA").Range("J15").Copy Destination:=rCil
   Set rCil = Nothing
End Sub


Na konec připisuje tohle

Kód: Vybrat vše

Sub faktura_vydana1()
Dim rCil As Range
   ' vybere listu faktura, vybere buňku a zkopíruje
   Set rCil = Sheets("VYDANÉ FAKTURY").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)        ' první buňku neznám
   Sheets("FAKTURA").Range("J15").Copy Destination:=rCil
   Set rCil = Nothing
End Sub


[castielo]

No to je paráda, funguje.
Mohl by jsi mi říct něco k tomu kódu, proč to tak je? Chtěl bych to pochopit, ne jen kopírovat.
A jak by to vypadalo, kdybych chtěl z listu "FAKTURY" kopírovat více položek do "VYDANÉ FAKTURY" kde by byl seznam. (konkrétně 5 položek které by tvořily seznam o 5 sloupcích). Cíl je, aby se v tom listu "VYDANÉ FAKTURY" tvořil jednoduchý seznam vydaných faktur, aby bylo vidět co bylo kdy vidět a za jakých podmínek (částka, komu, splatnost apod.).

Jinak jsem ti neskonale vděčný za pomoc, moc mi to pomáhá:)

/reakce na první příspěvek, ne na opravu/

//////////////////

Zkoušel jsem u tvůj druhý příspěvek, tu kombinaci obou kódu (ikdyž se v tom lehce ztrácím), samozřejmě funguje. Dokonale. Tohle bych chtěl taky umět

[lubo.]

Kód: Vybrat vše

Sub faktura_vydana()
Dim rCil As Range
   ' na listu "VYDANÉ FAKTURY" vybereme výchozí buňku ".Range("a1")" a1
   ' Tuto buňku si zapamatujeme v proměnné rCil "Set rCil = ..."
   Set rCil = Sheets("VYDANÉ FAKTURY").Range("a1")
   
   ' Pokud je tato buňka prázdná, máme cíl nalezen, jinak hledáme dále
   If Not IsEmpty(rCil) Then

      ' hledáme dále
      If Not IsEmpty(rCil.Offset(1, 0)) Then

         ' Pokud není naše buňka poslední v bloku, ctrl-šipka dolů skočí na poslední
         ' neprázdnou buňku v bloku
         Set rCil = rCil.End(xlDown)

         ' Skočíme tam tedy a tuto buňku si zapamatujeme
      End If

      ' V proměnné rCil máme poslední neprázdnou buňku bloku. Neřešíme, jestli to blok poslední
      ' může to býti "díra" mezi bloky
      ' Posuneme se tedy o 1 řádek dolů
      Set rCil = rCil.Offset(1, 0)

      ' Pozor! Pokud jsou poslední buňky bloku skryté, příkaz "rCil.End(xlDown)" se přesune
      ' na poslední *viditelnou* buňku. Příkaz "rCil.Offset(1, 0)" potom vybere následující skrytou
      ' buňku, která nemusí být prázdná. Při opakovaném volání procedury se bude tato první skrytá buňka
      ' stále přepisovat
   End If
   
   ' Na oblast "J15:N15" listu "FAKTURA" použijeme metodu Copy. Jejím argumentem je pravá horní buňka
   ' oblasti, kam se má oblast "J15:N15" zkopírovat. V našem případě je tato buňka uložena v proměnné rCil

   Sheets("FAKTURA").Range("J15:N15").Copy Destination:=rCil
   
   ' Uklidíme.
   Set rCil = Nothing
End Sub


Kód: Vybrat vše

Sub faktura_vydana1()
Dim rCil As Range
   ' na listu "VYDANÉ FAKTURY" vybereme buňku ".Cells" v posledním řádku "Rows.Count" a v 1. sloupci "1"
   ' Provedeme obdobu ctrl-šipka nahoru ".End(xlUp)" tím se dostaneme na nejspodnější vyplněnou buňku ve sloupci
   ' a pak se posuneme o řádek níže ".Offset(1, 0)"
   ' Buňku si zapamatujeme v proměnné rCil "Set rCil = ..."
   '
   ' Chybně to funguje, pokud je 1. sloupec prázdný - začne se vyplňovat od 2. řádku
   ' nebo když je posledních několik řádků vyplněných
   ' nebo když jsou některá řádky skryté (viz. předchozí procedura)
   
   Set rCil = Sheets("VYDANÉ FAKTURY").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
   
   ' Na oblast "J15:N15" listu "FAKTURA" použijeme metodu Copy. Jejím argumentem je pravá horní buňka
   ' oblasti, kam se má oblast "J15:N15" zkopírovat. V našem případě je tato buňka uložena v proměnné rCil
   Sheets("FAKTURA").Range("J15:N15").Copy Destination:=rCil

   ' Uklidíme.
   Set rCil = Nothing
End Sub


[castielo]

Perfektní vysvětlení, budu proměnné používat častěji. Ještě jednou díky za pomoc, jsem dlužníkem:)