< návrat zpět

MS Excel

Téma: VBA kopírování na poslední volný řádek rss

Zaslal/a meffisto 20.9.2017 19:50

Prosím o pomoc s makrem na kopírováním mezi dvěma sešity. Mám sešit import2.xlsm do kterého potřebuji nakopírovat data z sešitu plan_aktual.
V přiloze mám soubory kde jsem zkoušel různá makra, jak kopírování z xlsx souboru (první list), tak i import csv pomocí QueryTables (třetí list), řešení na druhém listu jsem našel někde na fóru. Bohužel mám problém s tím, že neumím, nastavit makro, tak aby další kopírování nepřepsalo řádky které tam jíž jsou (tak mi to funguje teď), ale přidaly se na poslední prázdný řádek. Protože sešit plan_aktual bude sloužit jako zdroj dat, který se bude každý den měnit. Na konci makra mám odstranění duplicit, které mi zajístí to abych v sešitě import2 neměl duplicitní záznamy. Nevím které řešení je vhodnější protože by tam mělo zůstat nastavené filtrování.
Tak jestli by mi někdo nemohl pomoc s kódem který mi zajistí to aby se kopírovalo na poslední volný řádek? Děkuji

Příloha: zip37684_import.zip (73kB, staženo 48x)
Zaslat odpověď >
Strana:  1 2   další »
marjankaj(20.9.2017 21:33)#037686
avatar
Neviem, načo si tam skopíroval zbytočnosti.
toto skopíruje z hárku2 do hárku1

Public Sub kopy()
Dim oblast As Range
Set oblast = Worksheets("hárok2").UsedRange
oblast.Copy Worksheets("hárok1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End Subcitovat
elninoslov(21.9.2017 10:49)#037707
elninoslov
...protože by tam mělo zůstat nastavené filtrování...

Neviem ako si predstavujete toto. Modelová situácia :
a
b
c
d
máme filter nastavený tak, že sa zobrazí iba
a
c
Pridáme na koniec
e
f
Odkiaľ má makro vedieť, či chceme e,f zobraziť alebo skryť? Excel totiž nevie či nás zaujíma výhradne iba a len a,b a ostatné máme na saláme. Alebo či sme salámisti práve iba a len voči b,d, a všetko ostatné by sme veľmi radi videli.
Proste nevie či chceme vidieť zaškrtnuté alebo nechceme vidieť nezaškrtnuté. To je zásadný rozdiel pri pridaní dát.

Preto je táto Vaša požiadavka nelogická.citovat
meffisto(21.9.2017 21:00)#037716
avatar
@elninoslov

S těmi filtry jsem to nenapsal nejlépe. Takže teď bych neřešil filtry.

Zkoušel jsem ještě napsat makro na zjištěni posledního volného řádku což se mi povedlo:
Sub Import()
Dim Radek As Range
Application.DisplayAlerts = False
Workbooks.Open Filename:="C:\Users\G510926\Desktop\import\plan_aktual.xlsx"
Data = ActiveWorkbook.Worksheets("List1").Range("D1:O150")
ActiveWorkbook.Close
Windows("import3.xlsm").Activate
' Najde poslední volný řádek
Set Radek = Sheets("Vstup").Range("A1")
If Not IsEmpty(Radek) Then
If Not IsEmpty(Radek.Offset(1, 0)) Then
Set Radek = Radek.End(xlDown)
End If
Set Radek = Radek.Offset(1, 0)
End If
Radek = Data
Set Radek = Nothing
Application.DisplayAlerts = True
End Sub

Akorát nyní stojím na tom, že po spuštění makra mi zkopíruje ze sešitu plan_aktual.xlsx hodnotu z buňky D1 do poslední volné buňky souboru import3.xml místo toho aby mi zkopíroval Range D1:O150. Takže chyba je v Radek = Data a já nyní nevím jak rozšířit oblast na posledním volném řádku o D1:O150 7

Přikládám i soubor
Příloha: zip37716_import.zip (52kB, staženo 32x)
citovat
elninoslov(21.9.2017 21:44)#037719
elninoslov
Pr.
Příloha: zip37719_import3.zip (30kB, staženo 52x)
citovat
meffisto(21.9.2017 21:45)#037720
avatar
Vzal jsem kousky kódu od marjankaje a zprasil toto:
Sub ImportV2()
Dim Radek As Range, Data As Range

Application.DisplayAlerts = False

Workbooks.Open Filename:="C:\Users\G510926\Desktop\import\plan_aktual.xlsx"
ActiveWorkbook.Worksheets("List1").Activate
Set Data = ActiveSheet.Range("D2:O100")
'ActiveWorkbook.Close
Windows("import3.xlsm").Activate

' Najde poslední volný řádek
Set Radek = Sheets("Vstup").Range("A1")
If Not IsEmpty(Radek) Then
If Not IsEmpty(Radek.Offset(1, 0)) Then
Set Radek = Radek.End(xlDown)
End If
Set Radek = Radek.Offset(1, 0)
End If

Radek.Select

Data.Copy ActiveCell

Set Radek = Nothing

' Odstranění duplicit
' Columns("A:L").Select
' ActiveSheet.Range("$A:$L").RemoveDuplicates Columns:=Array(2, 3), Header:=xlYes

Application.DisplayAlerts = True

End Sub

Což již funguje, ale kopíruje to data tak jak jsou tudíž i se vzorci a formátovánímcitovat
marjankaj(21.9.2017 21:54)#037721
avatar
A povedal si že vzorce nechceš kopírovať? A je problém to preformátovať po tvojom? To ti všetko treba urobiť ako na podnose?

Public Sub kopy()
Worksheets("hárok2").UsedRange.Copy
Worksheets("hárok1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Subcitovat
elninoslov(21.9.2017 22:59)#037722
elninoslov
meffisto, ja si myslím, že tá moja verzia robí presne to čo chcete. Vyremujte alebo Brakepoint-nite si to odstránenie duplicít a uvidíte. Len si ešte naformátujte stĺpce F:I ako dátum. Celé stĺpce, a len raz, neskôr pri importe nemusíte. Inak máte tam ešte nejaké makro vo Workbook.citovat
meffisto(25.9.2017 7:51)#037741
avatar
@ marjankaj Děkuji za pomoc, ten kód si uložím
@elninoslov Také děkuji za pomoc a máš opět pravdu funguje to na výbornou.

Děkuji Vám oběma.citovat
meffisto(6.10.2017 19:40)#037839
avatar
@elninoslov

Omlouvám se že s tím ješte otravuji, ale právě jsem zjistil že mi to kopíruje uplně jiné datumy ne sloupci I je na prvním řádku 8.9.2017 14:21:19 a ono to zkopíruje 7.9.2013 14:21:19
o den méně a z roku 2017 udělá 2013
a ani za boha nemohu přijít na to proč 6citovat
meffisto(6.10.2017 19:42)#037840
avatar
přikládám i kompletní soubory, akorát cestu je třeba si upravit
Příloha: zip37840_import.zip (50kB, staženo 132x)
citovat

Strana:  1 2   další »

Uživatelské menu

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

Menu

Formulář Faktura

Formulář Faktura IV

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

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje