kopirovani na tlacitko Vyřešeno

[slavi]

Dobry den/Ahoj,
mam problem s vytvorenim funkce/makra pro kopirovani.
v konecne podobne by to melo vypadat tak ze mam tlacitko u radku s daty a pri kliku na tlacitko se data z vybranych bunek na tom radku prenesou do jine tabulky pripadne na jiny list. problem je v tom ze se mi nedari prenest data na dalsi volny radek v urcene tabulce, protoze jakmile kliknu na tlacitko prenese se radek na prvni pozici v tabulce coz je spatne protoze se pak prepisuji data z dalsich rudku.
zkousel sem for cyklus na kontrolu radek ktery vypada zhruba takto, ale je to neohrabane a urcite spatne.

Kód: Vybrat vše

Sub prenes()
            'cteni
            adresa = Cells(10, 4)
            okres = Cells(10, 5)
            kraj = Cells(10, 6)           
    poc = 0
    i = 0   
    For i = 19 To 20 + poc
        If Cells(i, 11).Value = "" Then                       
            'zapis
            Sheets("List1").Cells(19 + poc, 11) = adresa
            Sheets("List1").Cells(19 + poc, 12) = okres
            Sheets("List1").Cells(19 + poc, 13) = kraj
            poc = poc + 1
       End If
    Next i
End Sub

[Reklama]

[navstevnik]

Tlacitko na zdrojovem listu je z ovladacich prvku ActiveX.
Udalostni procedura CommandButton1_Click vlozena do modulu zdrojoveho listu prenese hodnoty z bunek D10:F10 na cilovy list do sloupce K:J na prvni volny radek (na listu je hlavickovy radek K1:J1).

Kód: Vybrat vše

Option Explicit

Private Sub CommandButton1_Click()
  Dim PrvniVolnaBunka As Range
  ' na cilovem listu List2 v K1:J1 jsou hlavicky
  ' nalezeni prvni volne bunky ve sloupci K, tj. 11 sloupec
  With Worksheets("list2")
    Set PrvniVolnaBunka = .Cells(.Rows.Count, "K").End(xlUp).Offset(1, 0)
  End With
  ' prenest hodnoty z aktivniho listu D10:F10 na cilovy list pocinaje prvni volnou bunkou ve sloupci K
  PrvniVolnaBunka.Resize(1, 3).Value = Me.Range("d10:f10").Value
  Set PrvniVolnaBunka = Nothing
End Sub

Zanalyzuj si kod, pouzij napovedu, je plne postacujici.

[slavi]

tohle je co jsem potreboval.
ma to sice jeste chybu, ze kdyz se jeden radek odstrani tak to nebere v potaz a pokracuje to porad dal, ale to si snad uz nejak poladim.

mnohokrat dekuji

[navstevnik]

Odstraneni celeho radku v bloku radku na cilovem listu (at se jena o posledni radek nebo radek uvnitr bloku vyberem radku a Del) nebo odstraneni vyberu radku bunek ve sloupcich K:J (klavesami Ctrl+ - (minus)) nema vliv na vlozeni dalsiho radku na prvni volny radek.
Uved, o jake "odstraneni" radku se jedna.

[slavi]

tak ne.... radost byla predcasna
problem s vynechavanim radku je zasadni, jde o to,ze cilova oblast bunek je zhruva v prostredku a tato funkce neumi (nebo spise ja neumim) pokracovat v urcite oblasti na poslednim prazdnem radku - pokracuje za poslednim zaznamem v ve sloupci, nikoli na poslednim prazdnem miste.

tedy napr. kdyz je ve sloupci "A" zaznam na radku 1,2,3,6,7,9,10 nela by funkce vlozit zaznam na radek 4,5,8,11 postupne po ctyrech stisknuti tlacitka, nikoli na radek 11,12,13,atd jak to dela ted

[slavi]

asi jsem to napsal prve spatne...nejedna se o odstraneni celeho radku ale dat na radku - proste smazu Deletem obsah bunek, ale funkce toto nebere v potaz

[navstevnik]

Kód: Vybrat vše

Option Explicit

Private Sub CommandButton1_Click()
  Dim PrvniVolnaBunka As Range
  ' na cilovem listu List2 v K1:J1 jsou hlavicky
  ' nalezeni prvni volne bunky ve sloupci K, tj. 11 sloupec
  With Worksheets("list2")
    Set PrvniVolnaBunka = .Cells(1, "K").End(xlDown).Offset(1, 0)
  End With
  ' prenest hodnoty z aktivniho listu D10:F10 na cilovy list pocinaje prvni volnou bunkou ve sloupci K
  PrvniVolnaBunka.Resize(1, 3).Value = Me.Range("d10:f10").Value
  Set PrvniVolnaBunka = Nothing
End Sub

.
Puvodni dotaz nic blizsiho neuvadel, takze navrzene reseni tomu odpovidalo. Jednoduse receno: jaky dotaz, takova odpoved.

[slavi]

priznavam ze popsat nekomu vlastni myslenkovy pochod je obtizne a prve jsem popsla problem dosti spatne, nicmene stejne problem trva.

prikladam xls soubor,abych lepe vysvetlil jak bych potreboval, aby vse fungovalo
http://www.ulozto.cz/6534689/sesit2-xls

[navstevnik]

Upresni:
- tlacitek bude celkem 6 (proti kazdemu radku tabulky)?
- co v pripade, ze tabulka Data!D10:F20 bude plna?
- budou jeste nejake dalsi doplnujici pozadavky?

PS.: Ta pole se seznamem bys mohl pouzit z ovladacich prvku ActiveX.

[slavi]

doplneni:
-ano, tlacitko bude patrik ke kazdemu radnu - co radek to tlacitko
-rozsah tabulky je pevne dany a nikdy by nemelo dojit k preteceni, do tabylky se bude vzdy prenaset maximalne 3-4 radky zbytek je pouze jako rezerva, ale pro me ucely je tento rozsah maximalni a plne dostacujici
-v tento moment je toto jedine co me trapi

rePS: potrebuji to mit co nejjednodusi,abych se v tom pak casem vyznal

[navstevnik]

K reseni lze pristoupit ruznym zpusobem - sofistikovane nebo hrubou silou.
Prvni pristup umoznuje mit na listu radove desitky tlacitek s moznost pridavat tlacitka, aniz je nutno zasahovat do kodu procedur. Reseni v priloze Sesit2.xls
Druhy pristup co tlacitko to procedura - Sesit2_v1.xls.
PS.: A priste zkus pouzit prijemnejsi barvy na pozadi bunek, ty pouzite jsou vhodne tak pro barvoslepe, kterym to nekazi zrak.

[slavi]

dekuji za snahu,ale bohuzel mi neustale vyskakuje chyba pri stisku tlacitka:

Kód: Vybrat vše

Set PrvniVolnaBunka = .Cells(9, "D").End(xlDown).Offset(1, 0)

v obou dvou sesitech se jedna o stejnou chybu - jeste jsem do kodu nezasahoval