Hirdetés
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Luck Dragon: Asszociációs játék. :)
- ZolaMan: NerdQAxe++ 4.8TH/s SHA256 BTC Miner Modding
- Meggyi001: Kórházi ellátás: kuka vagy finom?
- sziku69: Fűzzük össze a szavakat :)
- sziku69: Szólánc.
- sh4d0w: Kalózkodás. Kalózkodás?
- bitpork: 2025, zárás
- weiss: Lakodalom van a mi utcánkban...
- eBay-es kütyük kis pénzért
-
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
-
tgumis
tag
válasz
Delila_1
#37546
üzenetére
Nos én nagyon béna vagyok
a munkafüzet minden lapját levédtem
jelszónak pw adtam meg és ugyanaz a hiba jön
Ne haragudj az értetlenségem miatt de már nincs ötletem.Sub Szur_Masol_Torol___()
Dim usor As Long, WSBev As Worksheet, WSOsz As Worksheet
Dim Bsor As Long, Csor As Long, valasz
valasz = MsgBox("Áttölthetem az adatokat?", vbYesNo + vbQuestion, "Választás")
If valasz = vbNo Then Exit Sub
'lapok védelmének feloldása a makró számára
WSBev.Protect Password:="pw", UserInterfaceOnly:=True
WSOsz.Protect Password:="pw", UserInterfaceOnly:=True
'értékadások
Set WSBev = Sheets("bevitel")
Set WSOsz = Sheets("ÖSSZESÍTÉS")
Bsor = WSOsz.Range("B" & Rows.Count).End(xlUp).Row + 1
usor = WSBev.Range("D2").End(xlDown).Row
'szűrés OK-ra
WSBev.ListObjects("bevitel").Range.AutoFilter Field:=17, Criteria1:="=OK"
'másolás és érték beillesztés
WSBev.Range("D2:T" & usor).Copy
WSOsz.Range("C" & Bsor).PasteSpecial xlPasteValues
'képlet, majd érték beillesztés a B oszlopba
Csor = WSOsz.Range("C" & Rows.Count).End(xlUp).Row
WSOsz.Range("B" & Bsor & ":B" & Csor) = "=B" & Bsor - 1 & "+1"
WSOsz.Columns(2).Copy
WSOsz.Range("B1").PasteSpecial xlPasteValues
'T2:W2 képlete az új sorokba az Összesítés lapon
WSOsz.Range("T2:W2").Copy
WSOsz.Range("T" & Bsor & ":W" & Csor).PasteSpecial xlPasteFormulas
Application.CutCopyMode = False 'kijelölés megszüntetése
With WSOsz.Range("B1").CurrentRegion 'keretezés
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
WSBev.ListObjects("bevitel").Range.AutoFilter Field:=17 'OK-ra szűrés megszüntetése
WSBev.Range("D2:E200,G2:G200,H2:I200,B1:B6").ClearContents 'törlés
End Sub
Új hozzászólás Aktív témák
- BESZÁMÍTÁS! MSI Z270 GAMING PRO CARBON alaplap garanciával hibátlan működéssel
- Törött Apple iMac 19.2 i5-8500 Radeon Pro 560X 4GB 16GB 256GB SSD 21.5" 4K Retina
- Eladó szép állapotban levő Samsung Galaxy A12 4/64GB kék / 12 hónap jótállás
- Samsung Galaxy Buds FE
- Samsung Galaxy A80 128GB, Kártyafüggetlen, 1 Év Garanciával
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50
