Hirdetés
- Szevam: Mennyire tipik Z-gen viselkedés? Tipizálható-e egyáltalán?
- Viber: ingyen telefonálás a mobilodon
- sziku69: Fűzzük össze a szavakat :)
- Luck Dragon: Asszociációs játék. :)
- Ismerkedés a Zyxel NSA325 v2-vel
- sziku69: Szólánc.
- Sundesz: 20 éve a PH!-n
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- eldiablo: Mennyire strapabíró egy GShock?
- Bestx: Budget DIY eGPU USB4/Thunderbolt csatlakozással – egy mining VGA új élete.
-
LOGOUT
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
lcdtv
tag
Látom Profi Mutt fórumtárs.
Egyszer már kérdeztem és van is rá megoldás sajna fizetős , de ha nincs más akkor megveszem.
Adott több munkalap azon belül 10 fül természetesen a fülek nevei ugyan azok. Ezeket kellene összevonnom egy munkalappá. Eddig csak egy fül volt, egy adott könyvtárba bemásoltam majd Indit gomb és összevonta az összes munkalapot ami a könyvtárba volt ( de csak az első fület )
ez volt a kód ( ha esetleg ezt át lehetne alakítani hogy minden fület fűzzön össze )Sub ttt()
mappak = Array("D:\Mappa\")
If Dir("D:\Mappa\eredmeny.xlsx") <> "" Then Kill "D:\Mappa\eredmeny.xlsx"
For Each mappa In mappak
Set uj = Workbooks.Add
fajl = Dir(mappa & "*.xlsx")
celsor = 1
Do While fajl <> ""
Workbooks.Open Filename:=mappa & fajl, ReadOnly:=True
sor = Range("a1").SpecialCells(xlLastCell).Row
If celsor = 1 Then
Range("a1", Range("a1").SpecialCells(xlLastCell)).Copy uj.Sheets(1).Cells(celsor, 1)
celsor = celsor + sor
Else
Range("a2", Range("a1").SpecialCells(xlLastCell)).Copy uj.Sheets(1).Cells(celsor, 1)
celsor = celsor + sor - 1
End If
ActiveWorkbook.Close False
fajl = Dir()
Loop
uj.SaveAs mappa & "eredmeny.xlsx"
uj.Close False
Next
MsgBox "Kész"
End Sub
Új hozzászólás Aktív témák
Hirdetés
- Bontatlan - BATTLEFIELD 1 Collectors Edition - Játékszoftver nélkül
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap
- Eladó Steam kulcsok kedvező áron!
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- AKCIÓ! AMD Ryzen 9 3900X 12 mag 24 szál processzor garanciával hibátlan működéssel
- Asus ROG G20AJ - Intel Core i7-4790, GTX 980
- BESZÁMÍTÁS! 500GB Samsung 980 NVMe SSD meghajtó garanciával hibátlan működéssel
- Bomba ár! Lenovo ThinkPad T470s - i5-6GEN I 8GB I 256GB SSD I 14" FHD I Cam I W10 I Garancia!
- Fém, összecsukható és kihúzható fotó állvány eladó
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Liszt Ferenc Zeneművészeti Egyetem
Város: Budapest