Hirdetés
- Luck Dragon: Asszociációs játék. :)
- sziku69: Fűzzük össze a szavakat :)
- Andras-G: #Kószagondolat - eMag tapasztalatok 2026-ban
- Andras-G: Az internet veszélyei [2. rész] - Facebook Marketpalce
- eBay-es kütyük kis pénzért
- Geri Bátyó: Agglegénykonyha 13 – Néhány egyszerű, de finom étel
- MasterDeeJay: Mi ez a pici videókártya? AMD E9173 teszt
- MasterDeeJay: Comet lake (10gen) és DDR3 - mert ilyet is lehet!
- Geri Bátyó: Agglegénykonyha 14 – Kések, késélezés
- aquark: Zsebszámológépek
-
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
- GYÖNYÖRŰ iPhone 12 mini 256GB Red -1 ÉV GARANCIA -Kártyafüggetlen, MS3627
- Sosemhasznált! HP OmniBook 5 Flip i5-1334U 16GB 512GB 14" áthajtós-érintős FHD+ Gar.: 1 év
- Keresünk S24/S24+/24 Ultra/S24 FE
- HP omen 17-w131ng bontva
- BESZÁMÍTÁS! 1TB Samsung 870 QVO 2,5" SATA SSD meghajtó garanciával hibátlan működéssel
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50