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

• #37532 tgumis tag

  Új Válasz 2018-03-16 11:09:05 #37532

  Ú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

  

  tgumis

  tag

  sziasztok
  Ismét makró összefűzéssel kapcsolatos problémába ütköztem
  adott két makró:
  1.(ezzel másolok a bevitel munkalapról)
  Sub D2_T_szurt_taromany_masol()
'
' munkalap védettség feloldás
Sheets("bevitel").Unprotect Password:="pw"
' szűrés
Sheets("bevitel").Range("D2").Activate
Sheets("bevitel").ListObjects("bevitel").Range.AutoFilter Field:=17, Criteria1:="=OK", Operator:=xlAnd
usor = Range("D2").End(xlDown).Row
' munkalap védetté tétele
Sheets("bevitel").Protect Password:="pw", UserInterfaceOnly:=True, AllowFiltering:=True, AllowFormattingColumns:=True
' másolás
Range("D2:T" & usor).Select
Selection.Copy

End Sub

  2. ezzel illesztem be az előző makróval kimásolt tartományt de egy másik munkalapra aminek a neve összesítés ÖSSZESÍTÉS

  Sub beilleszt()
Dim Bsor As Long
Dim Csor As Long
Dim i As Integer

Bsor = Range("B" & Rows.Count).End(xlUp).Row + 1

Range("C" & Bsor).PasteSpecial xlPasteValues

Csor = Range("C" & Rows.Count).End(xlUp).Row + 1
Range("T2:W2").Copy Destination:=Range("T" & Bsor & ":T" & Csor - 1)

For i = Bsor To Csor - 1
Range("B" & i) = Range("B" & i - 1) + 1
Next i
With Range("B1").CurrentRegion
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
End Sub

  Szóval a bevitel munkalapon állva indítanám a makrót és neki automatikusan át kellene rakni az összesítés munkalapra az egészet. plusz ráadásnak még szeretném a végén mindegyik munkalapot visszakódolni és a bevitelnél a törlést alkalmazni egy tartományban amire már kész a makró:
  Sub bevitel_torol()
' bevitel munkalapon törlés Makró
' munkalap védettség feloldás
Sheets("bevitel").Unprotect Password:="pw"
' szűrés kikapcsolása
Sheets("bevitel").ListObjects("bevitel").Range.AutoFilter Field:=17
' munkalap kijelölt celláiból érték törlése majd visszaállás az A2
Range("D2:E200,G2:G200,H2:I200").Select
Range("H2").Activate
Range("D2:E200,G2:G200,H2:I200,B1:B6").Select
Range("B1").Activate
Selection.ClearContents
Selection.ClearContents

' munkalap védetté tétele
Sheets("bevitel").Protect Password:="LiliLufi140127", UserInterfaceOnly:=True, AllowFiltering:=True, AllowFormattingColumns:=True
End Sub

  összegezve:
  tartomány szűrése másolásra majd átugrás másik munkalapra ott beillesztés keretezés majd visszaugrás a bevitel munkalapra és ott törlés. Majd minden munkalapot lekódolok. ha lehet munkalaponként kódolást szeretnék nem egyben a munkafüzetet.

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