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

• #16628 Delila_1 veterán Attas #16625

  Új Válasz 2013-02-08 13:01:25 #16628

  Ú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 Attas #16625 üzenetére

  Munka1 lapnak nevezem azt, amelyiken az eredeti adataid vannak, Munka2-nek azt, amelyikre másolok.
  A Munka1 Y1, Z1, és AA1 celláiba írom be (vagy választom ki érvényesítés segítségével) a 3 adatot.
  A Munka2 lapra előre átmásoltam a címsort.

  Sub Makro()
  Dim sor As Integer, usor As Integer, sor1 As Integer
  Dim WS1 As Worksheet, WS2 As Worksheet
  Dim a$, b$, c$
  Set WS1 = Sheets("Munka1") 'Itt változtathatsz
  Set WS2 = Sheets("Munka2") 'Itt változtathatsz
  usor = WS1.Cells(Rows.Count, "A").End(xlUp).Row
  sor1 = 2
  a$ = WS1.Range("Y1")
  b$ = WS1.Range("Z1")
  c$ = WS1.Range("AA1")
  
  'Előző adatok törlése a Munka2 lapon
  WS2.Rows("2:5000").Delete shift:=xlUp
  
  For sor = 2 To usor
  If WS1.Cells(sor, "U") = a$ And WS1.Cells(sor, "V") = b$ And _
  WS1.Cells(sor, "W") = c$ Then
  Rows(sor).Copy WS2.Cells(sor1, "A")
  sor1 = sor1 + 1
  End If
  Next
  End Sub

  Közben befutott egy másik megoldás is, de ha már megírtam, elküldöm.

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