< návrat zpět

MS Excel


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

Zaslal/a 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 43x)
Zaslat odpověď >

Strana:  1 2   další »
#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 Sub
citovat
#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
#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 30x)
citovat
#037719
elninoslov
Pr.
Příloha: zip37719_import3.zip (30kB, staženo 46x)
citovat
#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
#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 Sub
citovat
#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
#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
#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
#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 117x)
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