Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > microsoft.public.excel.programming > #111624

Re: Select identical column/rows based on the active cell and copy data to another sheet

Show all headers | View raw

Hi Johan,

Am Thu, 20 Aug 2020 09:01:53 -0700 (PDT) schrieb jmsla...@gmail.com:

> 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

Back to microsoft.public.excel.programming | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread

Thread

Select identical column/rows based on the active cell and copy data to another sheet "jmsla...@gmail.com" <jmslab2509@gmail.com> - 2020-08-20 09:01 -0700
  Re: Select identical column/rows based on the active cell and copy data to another sheet Claus Busch <claus_busch@t-online.de> - 2020-08-20 18:33 +0200
    Re: Select identical column/rows based on the active cell and copy data to another sheet "jmsla...@gmail.com" <jmslab2509@gmail.com> - 2020-08-20 11:09 -0700
    Re: Select identical column/rows based on the active cell and copy data to another sheet "jmsla...@gmail.com" <jmslab2509@gmail.com> - 2020-08-22 01:03 -0700
      Re: Select identical column/rows based on the active cell and copy data to another sheet Claus Busch <claus_busch@t-online.de> - 2020-08-24 20:38 +0200
        Re: Select identical column/rows based on the active cell and copy data to another sheet "jmsla...@gmail.com" <jmslab2509@gmail.com> - 2020-08-28 02:04 -0700

csiph-web