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

  • 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

Hirdetés