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

• #35865 Fferi50 Topikgazda föccer #35863

  Új Válasz 2017-07-31 14:36:10 #35865

  Ú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

  

  Fferi50

  Topikgazda

  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.

• #35864 Delila_1 veterán föccer #35863

  Új Válasz 2017-07-31 13:37:04 #35864

  Ú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 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

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