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

• #6546 Delila_1 veterán kb1987 #6541

  Új Válasz 2010-03-10 08:02:39 #6546

  Ú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 kb1987 #6541 üzenetére

  Az egyik üres lapodat nevezd el "Találatok"-nak, és a Munka1 címsorát másold át oda.

  A Munka1 A1 cellájába írd be a keresendő adatot.

  Sub Kigyujtes()
  Application.ScreenUpdating = False
  
  Sheets("Találatok").Select
  Rows("2").Select
  Range(Selection, Selection.End(xlDown)).Select
  Selection.Delete Shift:=xlUp
  
  Sheets("Munka1").Select
  Cells(1).Select
  sor_k = 2
  sz = Selection.Value
  
  Cells.Find(What:=sz, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
  :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
  False, SearchFormat:=False).Activate
  sor = Selection.Row: sor_m = sor + 1
  Rows(sor).Copy Sheets("Találatok").Rows(sor_k)
  sor_k = sor_k + 1
  
  Do 'Keresés ismétlése
  Cells.FindNext(After:=ActiveCell).Activate
  sor = Selection.Row
  Rows(sor).Copy Sheets("Találatok").Rows(sor_k)
  sor_k = sor_k + 1
  Loop While sor >= sor_m
  
  Sheets("Találatok").Select
  usor = ActiveSheet.UsedRange.Rows.Count
  Rows(usor).Select
  Selection.Delete Shift:=xlUp
  Cells(1).Select
  Application.ScreenUpdating = True
  End Sub

  Ez a makró kigyűjti a Találatok lapra a kért adatokat.

  Remélem, megfelel, mert ma csak délután leszek gép közelében.

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