Hi Johan,

Am Thu, 20 Aug 2020 09:01:53 -0700 (PDT) schrieb :

In a sheet the macro need to select all identical cells in column D that has the same text in it as cell D of the active row of the active cell and then copy the selected data to another sheet. After that it has to copy/paste several other columns but for the same rows selected.

For example...
The active cell is column K row 20. In this row in column D is 'AAA' registered. The macro had to to select in column D the cells above and below all the cells were also 'AAA' is registered (remarks; The cells are sorted so the ones with 'AAA' are always near each other, there is never another data registered in between of it).

Then this selected cells has to be copied to Sheet2 Cell A2.
The macro knows the range of selected rows. It should copy for the same rows the data from another column;
Column F to Sheet2 Cell B2
Column G to Sheet2 Cell C2
Column U to sheet2 Cell D2

try:

Sub FindAndCopy()
Dim rngBig As Range, c As Range
Dim FirstAddress As String

With Sheets("Sheet1")
Set c = .Columns("D").Find(what:=.Range("D" & ActiveCell.Row), _
lookat:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
If rngBig Is Nothing Then
Set rngBig = Union(c, .Range("F" & c.Row & ":G" & c.Row), _
.Range("U" & c.Row))
Else
Set rngBig = Union(rngBig, c, _
.Range("F" & c.Row & ":G" & c.Row), .Range("U" & c.Row))
End If
Set c = .Columns("D").FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddress
End If
End With
rngBig.Copy Sheets("Sheet2").Range("A2")
End Sub


Regards
Claus B.
--
Windows10
Office 2016