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

  • Attila7298

    újonc

    Sziasztok! tudnátok segíteni a megoldásban. Van egy munkalap arról szeretnék a 3,5, 7 oszlop szűrésével adatokat másolni egy másik munkalapra. A gond az hogy nem tudom megoldani hogy ha a keresés lefut az egy sorba tartozok ne külön sorba kerüljenek.
    Sub masolasi()
    Dim i, p, n, sor As Integer 'i-sor, n- sor a Munka2-n

    sor = Worksheets("Idöszakos").Cells(1, 1) 'utolsó sor
    n = 4
    t = Worksheets("Adat szürés").Cells(17, 6) 'kereset szám
    Sheets("Idöszakos").Activate

    For i = 4 To sor
    p = InStr(1, Cells(i, 3).Value, t, vbTextCompare)
    p1 = InStr(1, Cells(i, 5).Value, t, vbTextCompare)
    p2 = InStr(1, Cells(i, 7).Value, t, vbTextCompare)

    If p > 0 Then

    Worksheets("Sz_adat").Cells(n, 7).Value = Cells(i, 2).Value
    Worksheets("Sz_adat").Cells(n, 1).Value = Cells(i, 1).Value
    Worksheets("Sz_adat").Cells(n, 8).Value = Cells(i, 1).Value

    n = n + 1

    End If

    If p1 > 0 Then

    Worksheets("Sz_adat").Cells(n, 9).Value = Cells(i, 4).Value
    Worksheets("Sz_adat").Cells(n, 1).Value = Cells(i, 1).Value
    Worksheets("Sz_adat").Cells(n, 10).Value = Cells(i, 1).Value

    n = n + 1

    End If

    If p2 > 0 Then

    Worksheets("Sz_adat").Cells(n, 11).Value = Cells(i, 6).Value
    Worksheets("Sz_adat").Cells(n, 1).Value = Cells(i, 1).Value
    Worksheets("Sz_adat").Cells(n, 12).Value = Cells(i, 1).Value

    n = n + 1

    End If
    Next i

    End Sub

    ez az eredmény

    Előre köszi minden segítséget

    [ Szerkesztve ]

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