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

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

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

Show all headers | View raw

Hi Johan,

Am Sat, 22 Aug 2020 01:03:04 -0700 (PDT) schrieb jmsla...@gmail.com:

> I thought.......  easy to change so it can fullfill my wished result :(
> So I extended the code with the other columns that I need to copy, but.......  in another different way.

> But.............
> The code copied to Sheet2 A till H in the correct column (oke).
>  but in column I till W the data is I=AA, J=AB, K=AC till W=AO  instead of I=AA, J=AD, K=AG etc..
> It looks like the code can, wrote on this way, only handle with columns in the normal order.

for me it works fine.
But here is another suggestion:

Sub FindAndCopy()
Dim rngBig As Range, c As Range
Dim FirstAddress As String
Dim varRows() As Variant, varCols As Variant
Dim strCols As String
Dim n As Integer, i As Integer

strCols = "D, F, G, H, M, S, U, X, AA, AD, AG, AJ, AM, AB, AE, AH, AK,
AN, AC, AF, AI, AL, AO"
varCols = Split(strCols, ", ")

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
            ReDim Preserve varRows(n)
            varRows(n) = c.Row
            n = n + 1
            Set c = .Columns("D").FindNext(c)
        Loop While Not c Is Nothing And c.Address <> FirstAddress
    End If

    For i = LBound(varCols) To UBound(varCols)
        For n = LBound(varRows) To UBound(varRows)
            If rngBig Is Nothing Then
                Set rngBig = .Range(varCols(i) & varRows(n))
            Else
                Set rngBig = Union(rngBig, .Range(varCols(i) & varRows(n)))
            End If
        Next n
        rngBig.Copy Sheets("Sheet2").Cells(2, i + 1)
        Set rngBig = Nothing
    Next i
End With
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