Stránka 1 z 1

Uprava makra

Napsal: 02 čer 2021 21:29
od luko02420
Zdravím místní odborníky, potřeboval bych pomoc s upravou nasledujiciho makra.
Makro vyhleda prvni volny a nakopiruje hodnoty z jineho listu.
Potreboval bych tam nejak napasovat, aby po nakopirovani dat z jineho listu, makro vlozilo do dvou nasledujicich radku "-".

Kód: Vybrat vše

Sub Pocet_stitku() 'Kopíruje počet štítků na zaklade pravidla VLOŽENO DO MAKRA V MODULU 2

If Sheets("CSV").Range("K2") <= 10 Then 'když je v bunce L1 na liste Data hodnota mensí nez 10
   
    'zamezení překreslování obrazovky
    Application.ScreenUpdating = False

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("Štítky").Range("K1")
   
   ' 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("CSV").Range("F4:K7").Copy Destination:=rCil
   
   ' Uklidíme.
   Set rCil = Nothing

Dekuji za pomoc.

Re: Uprava makra

Napsal: 09 čer 2021 15:31
od Grimm
Výstřel zcela naslepo:
Pod řádek
Sheets("CSV").Range("F4:K7").Copy Destination:=rCil

Přidat
rCil.Offset(4).Resize(2, 6).Value = "-"

Re: Uprava makra

Napsal: 13 čer 2021 08:57
od luko02420
Díky vyzkousim