< návrat zpět

MS Excel


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

Zaslal/a 31.8.2020 15:20

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ší »
#047856
avatar
https://office.lasakovi.com/excel/vba-listy-bunky/radky-sloupce-excel-vba-kody/ aj.citovat
#047857
Lugr
Tak?citovat
#047859
Lugr
Možná malinko rychlejší a pro úpravu přehlednější. 1citovat
#047860
elninoslov
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
citovat
#047861
avatar
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
#047862
Lugr
Problikávání monitoru je způsobené bohužel právě Copy+PasteValues.citovat
#047863
avatar
lugr a čo tak proti preblikávaniu použiť
Application.ScreenUpdating=False ?citovat
#047864
Lugr

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
#047865
avatar
lugr áno, dvojica Copy a PasteValues sa dá obísť priamym priradenímcitovat
#047866
avatar
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ší »

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

Relativní cesta - zdroje Power Query

elninoslov • 25.4. 15:12

Relativní cesta - zdroje Power Query

Alfan • 25.4. 15:08

Relativní cesta - zdroje Power Query

elninoslov • 25.4. 14:21

Relativní cesta - zdroje Power Query

Alfan • 25.4. 10:49

Relativní cesta - zdroje Power Query

elninoslov • 25.4. 10:47

Relativní cesta - zdroje Power Query

Alfan • 25.4. 10:40

Relativní cesta - zdroje Power Query

Alfan • 25.4. 9:44