-
Fototrend
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
-
Delila_1
veterán
válasz
greenface
#22902
üzenetére
2007-től működik, alatta az FN = Dir(utvonal & "*.xlsx", vbNormal) sorban az xlsx helyett írj xls-t.
A Const utvonal = "C:\Adatok\Alkönyvtár\" sorba a saját útvonaladat vidd be.
Az indító fájlodban Alt+F11-re bejön a VB szerkesztő. Bal oldalon kiválasztva a füzetedet Insert menü, Module. Jobb oldalon kapsz egy üres lapot, oda kell bemásolnod a lenti makrót.
A füzetből az Alt+F8-ra megejelő ablakban kiválasztod, és futtatod a makrót.
A füzetet makróbarátként kell mentened (2007-estől felfelé, alatta sima mentés kell).Sub Erteket_Beilleszt()
Dim FN As String
Const utvonal = "C:\Adatok\Alkönyvtár\"
Application.DisplayAlerts = False
ChDir utvonal
FN = Dir(utvonal & "*.xlsx", vbNormal)
Do
If FN <> "." And FN <> ".." Then
Workbooks.Open Filename:=utvonal & FN
Sheets("material").Range("A5, A7, D10, A12, A14, B14, D14, A16, B16, C16, A18, B18") = _
Range("A5, A7, D10, A12, A14, B14, D14, A16, B16, C16, A18, B18").Value
Sheets("layout-volume").Range("A5, D5, A8, A10, C10, A12, C14") = _
Range("A5, D5, A8, A10, C10, A12, C14").Value
Sheets("Munka1").Delete
ActiveWorkbook.Save
ActiveWindow.Close
End If
FN = Dir()
Loop Until FN = ""
Application.DisplayAlerts = True
End Sub
Új hozzászólás Aktív témák
- PC Game Pass előfizetés
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Apple iPhone 15 Pro Max 256GB, Kártyafüggetlen, 1 Év Garanciával
- Dell Latitude 3510 15,6", i5 10210U, 8-16GB RAM, SSD, jó akku, számla, garancia
- Samsung Galaxy S24 Ultra 12/256GB Titanium Gray használt, megkímélt garancia 2027.12.27-ig
- Xiaomi Redmi Note 13 5G 256GB,Újszerű,Dobozaval,12 hónap garanciával
- iPhone 11 64GB Black -1 ÉV GARANCIA - Kártyafüggetlen, MS4346, 100% Akksi
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Central PC számítógép és laptop szerviz - Pécs
Város: Pécs
Fferi50
