Excel macro átalakítás

Ez a téma lezárásra került a moderátor által. A lezárás oka: Programozással, szoftverfejlesztéssel kapcsolatos kérdéssel a Prog.hu-t keresd fel a jövőben.
Excel macro átalakítás
2021-09-13T15:09:21+02:00
2021-09-13T15:09:23+02:00
2022-09-10T09:15:22+02:00
Gabor_Gabor
Tisztelt Fórumtagok,

Egy szakmai kérdéssel fordulok hozzátok. Van egy macro-m amelynek az a feladata, hogy ugyanolyan szerkezetű, de eltérő adattartalmú Excel-táblákat összefűzzön egy db. nagy adatbázissá. Ehhez két paramétert kell megadni.:

• a táblákat tartalmazó mappa elérési útvonalát, illetve
• a táblák melyik oszlopának adatsorát figyelje.

Ezek az összefűzendő Excel-táblák nem tartalmaznak képletet, illetve hivatkozásokat csak szöveg és szám adatokat. Az adatokat a macro egy aktív munkalapról kimásolja, de egy másik elrejtett lappal nem foglalkozik. A folyamat egy gomb megnyomásával indul és egymás után nyitja meg a táblákat és másolja ki az adatokat és bezárja. Csak azt kérdezi minden bezárásnál, hogy mentse-e vagy ne. Amint a kattintok ugrik a következő táblára ameddig el nem éri az utolsót.

Abban kérném a segítségeteket, hogy ezt a macro-kódot hogyan lehet úgy átalakítani, hogy:

Az összefűzendő forrás Excel-táblákból van több mint 50db. Felépítését tekintve egy forrás Excel-tábla 32 munkalapszegélyt tartalmaz. Ebből 31-be töltenek adatokat manuálisan, a 32. oldal pedig összeadja az előző 31 oldal adatait (szumma).  Azaz a 32. oldal tartalmaz hivatkozást és képletet.

Ezért kérdésem, hogy a lenti kód általakítható-e úgy:

• az összefűzendő adatrész a régivel ellentétben csak egy sor lenne minden Excel tábla utolsó munkalapszegélyén (32.)
• a másolandó sor tartalmaz képleteket, de azt ne másolja át, hanem csak az értéket és a szöveget amit a képlet kiszámol.
• Illetve az átmásolandó sor munkalapszegélye (32.) az elrejtett lenne, tehát úgy fűzze össze, hogy ne az aktív lapról hanem az elrejtettről.

A VBA kód.:

Sub ShowFileList()

    Dim fs, f, f1, fc, s
    nev = ActiveWorkbook.Name

    folderspec = Worksheets("alap").Cells(3, 6)
    h = Worksheets("alap").Cells(4, 6)

    K = 2

    Sheets("osszes").Select

    Cells.Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Sheets("alap").Select

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    Set fc = f.Files
    For Each f1 In fc

        s = folderspec & f1.Name
        Workbooks.Open Filename:=s
         Sheets(1).Select
        If Sheets(1).AutoFilterMode = True Then Selection.AutoFilter
        i = 2
        Do Until Cells(i, h) = ""
            i = i + 1
        Loop
        Rows("2:" & i - 1).Select
        Selection.Copy
        Windows(nev).Activate
        Sheets("osszes").Select
        Cells(K, 1).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveWindow.ActivateNext
        ActiveWorkbook.Close
        K = K + i - 2

    Next

    MsgBox "Finish"

End Sub

Válaszotok előre is köszönöm

Üdv.:
G
Mutasd a teljes hozzászólást!

Ez a téma lezárásra került a moderátor által. A lezárás oka: Programozással, szoftverfejlesztéssel kapcsolatos kérdéssel a Prog.hu-t keresd fel a jövőben.
abcd