Hirdetés
- Luck Dragon: Asszociációs játék. :)
- BerserkGuts: 9800X3D Hitvallás, Dogma megcáfolása egy RTX5080+12600K-val
- sziku69: Szólánc.
- sziku69: Fűzzük össze a szavakat :)
- btz: Internet fejlesztés országosan!
- Parci: Milyen mosógépet vegyek?
- GoodSpeed: Philips AWP9820 (vízlágyító) Calgon helyett?
- vrob: Próbálkozás 386 alaplap újraélesztésre
- Luck Dragon: Alza kuponok – aktuális kedvezmények, tippek és tapasztalatok (külön igényre)
- Met: Metallica: M72 World Tour
-
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
-
huliganboy
addikt
válasz
huliganboy
#29900
üzenetére
Végül ez lett a megoldás...
Sub ttt()
mappak = Array ' Nálad persze más és más
' lehet egy dir("e:",vbdirectory) a feltöltésben, ha egy mappán belül vannak.
For Each mappa In mappak
Set uj = Workbooks.Add
fajl = Dir(mappa & "*.xls")
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.xls"
'uj.Close False
Next
MsgBox "Kész"
End SubViszont még ebbe bele kellene aplikálni, hogy a C oszlopban azonos sorokat törölje illetve a megadott oszlopokat is törölje!!
[ Módosította: CoolMan ]
Új hozzászólás Aktív témák
- Projektor topic
- Intel Core i5 / i7 / i9 "Alder Lake-Raptor Lake/Refresh" (LGA1700)
- Milyen egeret válasszak?
- Apple Watch
- Samsung Galaxy Felhasználók OFF topicja
- Autóhifi
- Suzuki topik
- Luck Dragon: Asszociációs játék. :)
- Youtube Android alkalmazás alternatívák reklámszűréssel / videók letöltése
- Wise (ex-TransferWise)
- További aktív témák...
- Okosóra felvásárlás!! Samsung Galaxy Watch 5 Pro, Samsung Galaxy Watch 6 Classic
- BESZÁMÍTÁS! GIGABYTE A520M R3 3100 8GB DDR4 256GB SSD 1TB HDD GTX 1650 4GB ZALMAN N4 RGB 450W
- Keresünk Galaxy S22/S22+/S22 Ultra
- Decathlonos 43-as boxcipő, alig használt, hibátlan állapotban
- Új DELL UltraSharp U2722DE 27" monitor QHD LCD IPS 27% ÁFÁs
Állásajánlatok
Cég: Laptopszaki Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Fferi50
