Hirdetés
- Luck Dragon: Asszociációs játék. :)
- sziku69: Fűzzük össze a szavakat :)
- Magga: PLEX: multimédia az egész lakásban
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- doc: Regisztrált 2003-02-27 10:12, azaz 7303 napja - nagyúr
- gban: Ingyen kellene, de tegnapra
- aquark: Zsebszámológépek
- Luck Dragon: Alza kuponok – aktuális kedvezmények, tippek és tapasztalatok (külön igényre)
- Geri Bátyó: Agglegénykonyha 14 – Kések, késélezés
- Parci: Milyen mosógépet vegyek?
-
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
-
Delila_1
veterán
válasz
tgumis
#37532
üzenetére
A lenti sor a MAKRÓ részére feloldja a lap védettségét.
Sheets("Lapneve").Protect Password:="pw", UserInterfaceOnly:=TrueHa előtte nem volt levédve a lap, akkor a beírt jelszóval védetté teszi.
Minek ehhez 3 makró? Eggyel is meg lehet oldani. Arra kell ügyelned, hogy a jelszó a bevitel lapon a makró végén megváltozik (pw-ről LiliLufi140127-re), legközelebb indításkor az újat kell megadnod.
Sub Szur_Masol_Torol()
Dim usor As Long, WSBev As Worksheet, WSOsz As Worksheet
Dim Bsor As Long, Csor As Long
'értékadások
Set WSBev = Sheets("bevitel")
Set WSOsz = Sheets("ÖSSZESÍTÉS")
Bsor = WSOsz.Range("B" & Rows.Count).End(xlUp).Row + 1
WSBev.Protect Password:="pw", UserInterfaceOnly:=True
WSOsz.Protect Password:="pw", UserInterfaceOnly:=True
'szűrés OK-ra
WSBev.ListObjects("bevitel").Range.AutoFilter Field:=17, Criteria1:="=OK"
'másolás és érték beillesztés
usor = WSBev.Range("D2").End(xlDown).Row
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
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
'új jelszó a bevizel laphoz
WSBev.Protect Password:="LiliLufi140127", UserInterfaceOnly:=True, _
AllowFiltering:=True, AllowFormattingColumns:=True
End Sub
Új hozzászólás Aktív témák
- Ha az alaplapi hangchipnél jobbra váltanál, itt az új Sound Blaster hangkártya
- iPhone topik
- AMD vs. INTEL vs. NVIDIA
- Luck Dragon: Asszociációs játék. :)
- Yettel topik
- sziku69: Fűzzük össze a szavakat :)
- Elektromos autók - motorok
- Itt a Galaxy S26 széria: az Ultra fejlődött, a másik kettő alig
- NVIDIA GeForce RTX 5080 / 5090 (GB203 / 202)
- Jobb zajszűréssel és okos funkciókkal töltve megjelent az Apple AirPods Max 2
- További aktív témák...
- Dell Vostro 3425 6magos Ryzen 5 5625U 16GB RAM 512GB SSD 1 év garancia
- Beszámítás! Asus VG27AQ3A 27 180Hz QHD IPS 1ms monitor garanciával hibátlan működéssel
- Dell UltraSharp 24 USB-C Hub Monitor - U2422HE - 27% ÁFÁs
- Apple iPhone 12 Pro Max/128GB / Kártyafüggetlen / 12Hó Garancia / Akku:85%
- Részletfizetés. BankMentes. Kamatmentes. Új noblechairs EPIC műbőr FEKETE - FEKETE. 3 év garancia!
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50