Külső Excel táblából adatok átmásolása makróval

Excelmarketing - Excel VBA makró blog -Külső Excel táblából adatok átmásolása makróval

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.

“Tallozas” nevű makró hozzárendelése a gombunkhoz

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:

A makrónk segítségével kiválaszthatjuk a szükséges fájlt
Ha betallóztuk a külső adatforrás táblázatunkat, akkor A1 cellában megjelenik a fájlunk elérési útvonala, amit később rugalmasan
fel tudunk használni.

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:

  1. 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”
  2. Kimásolja a meghatározott munkalapon (“copyThis”) szereplő adatokat
  3. Bemásolja a mi Excel táblánk meghatározott munkalapjára (“pasteHere”)
  4. Mentés nélkül bezárja az adatforrást tartalmazó Excel táblát
  5. 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! 🙂

Mennyire találtad hasznosnak ezt cikket?
[Összes szavazat: 2 Átlag értékelés: 5]