- Xiaomi 14T - nem baj, hogy nem Pro
- Azonnali mobilos kérdések órája
- iPhone topik
- Poco F7 – bajnokesélyes
- A napon sütkérezik a OnePlus 15
- Megérkezett végre a várva-várt órafrissítés
- „Új mérce az Android világában” – Kezünkben a Vivo X300 és X300 Pro
- Samsung Galaxy S24 - nos, Exynos
- Fotók, videók mobillal
- Apple Watch
-
Mobilarena
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
slashing #22192 üzenetére
A DoWork makró End With fölötti sora legyen
Workbooks(WBN).Sheets(WS).Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
Szerk.:
Inkább leírom a 2. makrót is.
Sub DoWork(wb As Workbook, WBN, WS)
Dim usor As Long, cell As Range, selectRange As Range
With wb
usor = .Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row
For Each cell In .Sheets(1).Range("A3:A" & usor)
If (cell.Value <> "") Then
If selectRange Is Nothing Then
Set selectRange = cell
Else
Set selectRange = Union(cell, selectRange)
End If
End If
Next cell
usor = Workbooks(WBN).Sheets(WS).Range("A" & Rows.Count).End(xlUp).Row + 1
selectRange.Copy
Workbooks(WBN).Sheets(WS).Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
End With
End Sub -
Delila_1
veterán
válasz
slashing #22192 üzenetére
Próba nélkül az első makró (nálam most éppen bedöglött az Excel).
Sub ProcessFiles()
Dim Filename, Pathname As String, WBN As String, WS As String
Dim wb As Workbook
Application.ScreenUpdating = False
WBN = ActiveWorkbook.Name
WS = ActiveSheet.Name
Pathname = "C:\teszt\" & WS & "\"
Filename = Dir(Pathname & "*.xlsx")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
DoWork wb, WBN, WS
wb.Close SaveChanges:=True
Filename = Dir()
Loop
Application.ScreenUpdating = True
End SubBármelyik oldalról indítva elméletileg a saját könyvtárából hívja be, és másolja a füzetek adatait.
Új hozzászólás Aktív témák
- Audi, Cupra, Seat, Skoda, Volkswagen topik
- VR topik (Oculus Rift, stb.)
- AMD Navi Radeon™ RX 9xxx sorozat
- GTA V
- Felforgatná Kína a technológiai világrendet
- Sokkal drágább lett az „olcsó” Tesla, mint várták
- Autóápolás, karbantartás, fényezés
- Kínai és egyéb olcsó órák topikja
- Elite: Dangerous
- Battlefield 6
- További aktív témák...
- Lenovo ThinkPad T15 Gen1 Intel Core i5-10210U
- GYÖNYÖRŰ iPhone 13 Pro Max 128GB Graphite -1 ÉV GARANCIA - Kártyafüggetlen, MS3540
- ÁRGARANCIA!Épített KomPhone Ryzen 5 7500F 32/64GB DDR5 RTX 5060 8GB GAMER PC termékbeszámítással
- iPhone 13 128GB Starlight- 1 ÉV GARANCIA, Kártyafüggetlen,MS3436
- Konzol felvásárlás!! Xbox Series S, Xbox Serries X
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopműhely Bt.
Város: Budapest