CODEWITHSUNDEEP
excelvba
Kano
Kano

Reputation: 37

Find a text in a range and copy the next Activecell.offset(1,1)16 cells to destination

I have a range I13 to I6076. I am starting at first I13 cell and finding a match in Range("D12:D103333"). If it finds a match in Col D then it should offset Activecell.offset(1,1) from Col D cell and copy the next 16 cells(vertical copy) to corresponding I13 row(horizontal paste). and then move on to I14 and so on. I have created a do while loop to find the cells in the range Range("D12:D103333"), but how do I offset and copy the next 16 cells. and then go to next cell in col I. Any help would be greatly appreciated. Many Thanks. Code is below.

Sub Kantar()

    Dim Category As String
    i As Integer
    
    Range("I13").Select
    Do While Not IsEmpty(ActiveCell)
        Category = ActiveCell.Value
        Range("D12:D103333").Find(What:=Category, MatchCase:=True).Select
           
        ActiveCell.Offset(1, 0).Select
    Loop

End Sub

Upvotes: 2

Views: 1889

Answers (2)

Kano
Kano

Reputation: 37

Firstly I would like to Thank Busse for providing me the logical steps to get my answer. It was Super helpful. So I am copying my code below which might help several users with similar issues. Thanks:))

Sub Kantar2()

    Dim Category As String, i As Long, FinalRow As Long
    Dim Rng As Range, MyCell As Range

    Application.ScreenUpdating = False
    i = 10
    FinalRow = Cells(Rows.Count, 4).End(xlUp).Row
    Set Rng = Range("I13:I6086")
    For Each MyCell In Rng
        Category = MyCell.Value
        Range(Cells(i, 4), Cells(FinalRow, 4)).Find(What:=Category, MatchCase:=True).Select
        i = ActiveCell.Row
        ActiveCell.Offset(1, 1).Select
        Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row + 15, 5)).Copy
        MyCell.Offset(0, 1).PasteSpecial Transpose:=True
    Next MyCell
    Application.ScreenUpdating = True
End Sub

Upvotes: 0

Busse
Busse

Reputation: 863

Try doing something like this:

1) Once the cell is found, activecell.offset(1,1)

2) From there, use your activecell.address and activecell.address + 16 as a range to do range.copy

3) Offset the active cell to where you want to paste.

4) Paste Special with transpose to transpose it horizontally (use macro recorder to show you how if you are unsure)

5) Offset back to original cell (coordinates based on where you end up)

6) Offset down 1 cell and continue the loop. (Which you already have coded)

I'd give actual code but I'm not at a PC. Hopefully these steps still help if someone else doesn't give you the code :)

Upvotes: 0

Related Questions