Keresés

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

  • Delila_1

    Topikgazda

    válasz föccer #35863 üzenetére

    Szűrés után futtathatod a modulba másolt makrót.

    Sub sorszam()
    Dim sor As Long, oszlop As Integer
    For sor = 23 To 1000
    If Rows(sor).Hidden = False Then
    For oszlop = 1 To 5
    Cells(1, oszlop) = Cells(sor, oszlop)
    Next

    For oszlop = 15 To 24
    Cells(1, oszlop) = Cells(sor, oszlop)
    Next
    Exit Sub
    End If
    Next
    End Sub

    [ Szerkesztve ]

    Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

  • Fferi50

    őstag

    válasz föccer #35863 üzenetére

    Szia!

    Ezt a makrót is megpróbálhatod:

    Sub masol()
    Dim rrange As Range
    Set rrange = Range(Range("A22"), Cells(Range("A22").End(xlDown).Row, Range("A22").End(xlToRight).Column)).SpecialCells(xlCellTypeVisible) ' a szűrés után látható cellák
    If rrange.Areas.Count = 1 Then 'ha egybefüggő a tartomány
    Set rrange = rrange.Rows(2) 'a második sor kell nekünk
    Else
    If rrange.Areas(1).Rows.Count >= 2 Then 'ha az első terület legalább 2 sorból áll
    Set rrange = rrange.Areas(1).Rows(2) 'a második sora kell nekünk
    Else
    Set rrange = rrange.Areas(2).Rows(1) 'az első terület egy sorból állt, ezért a második terület első sora kell nekünk
    End If
    End If
    With Rows(18) ' a 18. sorba átírjuk az értékeket.
    .Cells(1).Value = rrange.Cells(1).Value
    .Cells(5).Value = rrange.Cells(5).Value
    Range(.Cells(1, "o"), .Cells(1, "x")).Value = Range(rrange.Cells(1, "o"), rrange.Cells(1, "x")).Value
    End With
    End Sub

    Ez akkor működik hibátlanul, ha a szűrősorodban és az adattábládban mindenütt van adat, a tartomány végéig, nincsenek üres cellák közben.

    Üdv.

    [ Szerkesztve ]

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