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

• #29235 Delila_1 veterán irodakukac #29233

  Új Válasz 2015-10-27 12:33:12 #29235

  Ú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 irodakukac #29233 üzenetére

  A modulba írtat kiegészítettem azzal, hogy a házipénztár lap előző adatait törölje az új másolás előtt.

  Sub Hó_Eleji_KpMásolás()
  Dim usor As Long, ter As Range
  
  usor = Range("A" & Rows.Count).End(xlUp).Row
  
  'Előző adatok törlése a házipénztár lapon
  Set ter = Sheets("házipénztár").Range("A1").CurrentRegion
  ter.Offset(1, 0).Resize(ter.Rows.Count - 1, ter.Columns.Count - 1).ClearContents
  
  'Szűrés készpénzre
  ActiveSheet.Range("$A$1:$T$" & usor).AutoFilter Field:=8, Criteria1:="készpénz"
  
  'Szűrt sorok másolása
  Range("A2:T" & usor).SpecialCells(xlCellTypeVisible).Copy Sheets("házipénztár").Range("A2")
  
  'Szűrés megszüntetése
  ActiveSheet.Range("$A$1:$T$" & usor).AutoFilter Field:=8
  End Sub

• #29234 Delila_1 veterán irodakukac #29233

  Új Válasz 2015-10-27 12:08:13 #29234

  Ú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 irodakukac #29233 üzenetére

  Szia!

  Írtam egy másik makrót, ami megoldja a hóeleji másolást. Ezt a makrót modulba tedd (a Téma összefoglaló szerint). Most írtam bele néhány megjegyzést, hogy tudd, melyik sor mire való.

  Sub Hó_Eleji_KpMásolás()
  Dim usor As Long, usorHP
  
  usor = Range("A" & Rows.Count).End(xlUp).Row
  usorHP = Sheets("házipénztár").Range("A" & Rows.Count).End(xlUp).Row + 1
  
  'Szűrés készpénzre
  ActiveSheet.Range("$A$1:$T$" & usor).AutoFilter Field:=3, Criteria1:="készpénz"
  
  'Szűrt sorok másolása
  Range("A2:T" & usor).SpecialCells(xlCellTypeVisible).Copy Sheets("házipénztár").Range("A" & usorHP)
  
  'Szűrés megszüntetése
  ActiveSheet.Range("$A$1:$T$" & usor).AutoFilter Field:=3
  End Sub

  Érdemes kitenni egy gombot. Lehet ez egy csinos alakzat a felső sorban. Jobb klikk rajta, Makró-hozzárendelés, majd kiválasztod – ha van választék – a Hó_Eleji_KpMásolás-t. Ez a kényelmesebb módszer, de gomb nélkül is indíthatod pl. az Alt+F8-as megoldással.

  Szerk.: A laphoz rendelt makróban lesz egy apró változás, hogy ne fusson hibára, mikor hó elején a sok adatot egyszerre bemásolod. A csillagos sor új.

  Private Sub Worksheet_Change(ByVal Target As Range)
  Dim ide As Long, sor As Long
  
  If Target.Count > 1 Then Exit Sub '**********
  If Target.Column = 20 Then
  sor = Target.Row
  If Range("H" & sor) = "készpénz" Then
  ide = Application.WorksheetFunction.CountA(Sheets("házipénztár").Columns(1)) + 1
  Range("A" & sor & ":T" & sor).Copy Sheets("házipénztár").Range("A" & ide)
  End If
  End If
  End Sub

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