Hirdetés

  2. Fórumok
  3. OS, alkalmazások
  4. Microsoft Excel topic
  5. (kiemelt téma)
Legfrissebb anyagok
Mobilarena témák
PROHARDVER! témák
IT café témák
GAMEPOD témák
  • Téma összefoglaló
    Utoljára frissítve: 2023-11-13 08:31

    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

  • #37540 Delila_1 veterán tgumis #37537
    Új Válasz #37540
    Új hozzászólás
    Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
    Privát üzenet küldése

    Delila_1

    veterán

    válasz tgumis #37537 üzenetére

    A makró elejére beírtam a kérdést, a vége felé meg ott van a képletek másolása.

    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

    'új jelszó a bevitel laphoz
    WSBev.Protect Password:="LiliLufi140127", UserInterfaceOnly:=True, _
    AllowFiltering:=True, AllowFormattingColumns:=True
    End Sub

Új hozzászólás Aktív témák