Tegyük fel, hogy van egy Excel táblánk, amiben hetente dolgozunk fel adatokat a kimutatásunkhoz. A forrásadatok egy másik Excel táblából származnak, amit mondjuk egy másik osztályon lévő kollégánk állít elő szintén hetente. Az ő Excel táblájának egyik munkalapja kell csak nekünk, de hatalmas macera lenne minden héten azt megnyitni és CTRL+C, CTRL+V-zni. Nincs mese automatizálni kell.
1. Külső fájl elérési útjának meghatározása
Először is, mi van ha a kollégánk megváltoztatja az elérési útvonalát a forrásadatot tartalmazó Excelének, vagy pl év végekor csinál neki egy adott év nevű mappát és beleteszi. Nem akarunk minden évben belenyúlni a VBA programunkba, így először ezt fogjuk lekezelni.
Azt szeretném, hogy egy „Tallózás” gombot megnyomva, egy cellába kiírjam a betallózott Excel tábla elérési útvonalát, hogy később a programom ezt olvassa ki mindig.
Így könnyen tudom változtatni, ha esetleg más helyre kerül a forrás tábla.
Első lépésben nyissunk egy makróbarát Excel táblát, hozzunk létre benne egy munkalapot „CP” néven, mint control panel. Ide fogjuk tenni a gombajinkat. Szúrjunk be egy gombot, írjuk ki rá, hogy „Tallózás” és rendeljünk hozzá egy új makrót „Tallozas” néven.
Ezután írhatjuk is a VBA programunkat. Íme a „Tallozas” makrónk kódja:
Sub Tallozas()
Dim ws As Worksheet
Dim strFile As Variant
Set ws = ActiveWorkbook.Sheets("CP") '
'Tallózás, melyben egy változóban tároljuk az megnyitott fájl elérési útvonalát
strFile = Application.GetOpenFilename("Text Files (*.*),*.*", , "Please select file...")
If strFile = False Then
'Ha nem nyitunk meg semmit akkor kilépünk.
Exit Sub
Else
'Ha kiválasztottuk a fájlt, akkor az A1 cellába írjuk ki az elérési útvonalát
Worksheets("CP").Range("A1").Value = strFile
End If
End Sub
Ha megvagyunk akkor tesztelhetjük. Kattintsunk a gombunkra:
1. Egy teljes munkalap átmásolása külső táblából
Most jön a lényeg, azaz bemásoljunk a mi táblánkba a külső Excel egyik munkalapját. A mi Excelünk neve legyen „Saját Táblánk.xlsm”. A „CP” munkalap mellett pedig hozzunk létre egy új munkalapot „pasteHere” néven. Ide fogjuk makróval bemásolni a külső táblából („Külső adatforrás tábla.xlsx”) az adatokat. Méghozzá ott pedig a „copyThis” munkalapról.
„CP” fülre szúrjunk be még egy gombot, amihez adjunk hozzá egy új makrót „toCopy” néven.
A következőt fogja tenni a makrónk:
- Megnyitja az „CP” munkalapon az A1 cellában lévő elérési útvonalú Excel táblát, mely neve „Külső adatforrás tábla.xlsx”
- Kimásolja a meghatározott munkalapon („copyThis”) szereplő adatokat
- Bemásolja a mi Excel táblánk meghatározott munkalapjára („pasteHere”)
- Mentés nélkül bezárja az adatforrást tartalmazó Excel táblát
- Kiírja egy msgbox-xal, hogy „kész”
Íme a kódunk:
Sub toCopy()
'Létrehozunk egy változót már az elején, amiben mérni fogjuk a külső adatforrás munkafüzetben lévő számunkra szükséges munkalap utolsó sorát. Tehát ha 10 sornyi adat van benne akkor tíz sort másoljunk ki. Ha 1000 akkor ezret.
Dim LastRow As Long
'Szintén egy változóba elmentjük az A1 cellában szereplő útvonalat, ami fájlt meg akarunk majd nyitni.
Dim source1 As String
source1 = Worksheets("CP").Range("A1").Value
'1.0 Ha van már adat a "pasteHere" munkalapunkon akkor azt illő törölni előtte. (Tegyük fel, hogy S oszlopig számítunk adatra.)
ThisWorkbook.Worksheets("pasteHere").Columns("A:S").ClearContents
'1.1 Megnyitjuk a munkafüzetet
Workbooks.Open source
'1.2 CopyPaste
'Megnézzük, hogy mi az utolsó sor a megnyitott külső adatforrás Excelben
LastRow = Workbooks("Külső adatforrás tábla.xlsx").Worksheets("copyThis").Cells(Rows.Count, "A").End(xlUp).Row
'Kimásoljuk az adatokat, az utolsó sorig és az S oszlopig
Workbooks("Külső adatforrás tábla.xlsx").Worksheets("copyThis").Range("A1:S" & LastRow).Copy
'beillesztjük a mi táblánkba
Workbooks("Saját Táblánk.xlsm").Worksheets("pasteHere").Range("A1").PasteSpecial Paste:=xlPasteValues
'Letiltjuk, a felugró vágólapos üzenetet
Application.CutCopyMode = False
'1.3 Bezárjuk a külső munkafüzetet
Workbooks("Külső adatforrás tábla.xlsx ").Close SaveChanges:=False
'1.4 Kiírjuk, hogy készen vagyunk
ThisWorkbook.Worksheets("pasteHere").Select
MsgBox "KÉSZ"
End Sub
Ha megvan, teszteljük.
Remélem segített. Bármi kérdés vagy észrevétel van, írj bátran üzenetet! 🙂