MS Excel

Dobrý den,

rád bych požádal o pomoc. Mám data v jednom listu, která potřebuji nakopírovat do jiného listu do databáze (která se neustále bude zvětšovat).
Potřeboval bych vždy najít poslední řádek v databázi a pod něj do nových řádků a příslušných buněk nakopírovat data z prvního listu.
Nyní mi funguje vždy pro 1. řádek, ale potřeboval bych to elegantně pro více kopírovaných řádků.
Pomůže, prosím, někdo?

Zaslat odpověď >

Strana: 1 2 další »

Rejpal(31.8.2020 16:52)#047856

https://office.lasakovi.com/excel/vba-listy-bunky/radky-sloupce-excel-vba-kody/ aj.citovat

Lugr(31.8.2020 18:04)#047857

Tak?

Příloha: zip

47857_najdi-posledni-radek-a-zapis-do-prislusneho-sloupce.zip (287kB, staženo 64x)

citovat

Lugr(31.8.2020 21:45)#047859

Možná malinko rychlejší a pro úpravu přehlednější.

Příloha: zip

47859_najdi-posledni-radek-a-zapis-do-prislusneho-sloupce.zip (280kB, staženo 86x)

citovat

elninoslov(31.8.2020 22:49)#047860

Ja by som to nerobil cez Copy+PasteValues, ale rovno priradenie hodnôt.
Sub NACIST_NEWDATA()
Dim Radek As Long
Dim Pocet As Long

' Počet nových položek, určující je sloupec A:A
Pocet = wsNewData.Cells(Rows.Count, "A").End(xlUp).Row - 2
If Pocet = 0 Then MsgBox "Nejsou žádná nová data.", vbExclamation: Exit Sub

' První volný řádek v DB, určující je sloupec A:A
Radek = wsVTabulce.Cells(Rows.Count, "A").End(xlUp).Row + 1

With wsNewData.Range("B3").Resize(Pocet)
' Datum
wsVTabulce.Cells(Radek, "A").Resize(Pocet).Value = Date

' Značka
wsVTabulce.Cells(Radek, "D").Resize(Pocet).Value = .Value

' Kód, název, bližší určení
wsVTabulce.Cells(Radek, "F").Resize(Pocet, 3).Value = .Offset(0, 1).Resize(, 3).Value

' Skupina
wsVTabulce.Cells(Radek, "R").Resize(Pocet).Value = .Offset(0, 4).Value

' Dodavatel
wsVTabulce.Cells(Radek, "L").Resize(Pocet).Value = .Offset(0, 5).Value

' Položky
wsVTabulce.Cells(Radek, "K").Resize(Pocet).Value = .Offset(0, 6).Value

' Kopírované data
wsVTabulce.Cells(Radek, "AV").Resize(Pocet, 10).Value = .Offset(0, 17).Resize(, 10).Value
End With

MsgBox "Zapsáno " & Pocet & " nových řádků do databáze.", vbInformation
End Sub

Příloha: zip

47860_najdi-posledni-radek-a-zapis-do-prislusneho-sloupce2.zip (26kB, staženo 39x)

citovat

MilaF(1.9.2020 0:01)#047861

Teda, moc děkuji za řešení. Vypadá to, že obě fungují. U řešení od lugr mi monitor problikává, nevím proč, jestli je počítání náročnější.
Zkusím použít řešení od elninoslov.
Oběma moc děkuji.citovat

Lugr(1.9.2020 6:02)#047862

Problikávání monitoru je způsobené bohužel právě Copy+PasteValues.citovat

robert13(1.9.2020 8:24)#047863

lugr a čo tak proti preblikávaniu použiť
Application.ScreenUpdating=False ?citovat

Lugr(1.9.2020 11:04)#047864

robert13 napsal/a:

lugr a čo tak proti preblikávaniu použiť

Application.ScreenUpdating=False

Jo to je dobrý nápad, ale i tak to elninoslov má lepší.citovat

robert13(1.9.2020 11:22)#047865

lugr áno, dvojica Copy a PasteValues sa dá obísť priamym priradenímcitovat

MilaF(2.9.2020 10:09)#047866

Omlouvám se, ale ještě jedna věc.
Musel jsem v změnit názvy listů (newdata na newdatao a vtabulce na evidence20) a hle makro od elninoslov funguje.
Pokud ale chci použít toto řešení i v jiném souboru, tak mi to píše Run-time error 424 a zastaví se na řádku
Pocet = wsNewData.Cells(Rows.Count, "A").End(xlUp).Row - 2
Souvisí to nějak s názvem listů?citovat

Strana: 1 2 další »

Téma: Najít poslední řádek+zapsat do příslušné buňky

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje