Excel VBA: Copy from one worksheet to another

Question

So I have a workbook with two sheets in it. I need to copy data from worksheet 2 ("Detail") to worksheet 1 ("Syncrofit"). The items from ws2 I need to paste into progressive rows on sheet 1, so rows in sheet two, column B which say "Joint1-1" need to be inserted below row 1 on sheet 1. This essentially creates a nested table.

Here's what I have so far, mostly scraped together from code and help I've found around here:

Sub SelectJoints()
Sheets("Detail").Activate
Dim Selection1 As Integer, Selection2 As Integer
Dim SelectionRange As Range
Dim num As Integer


Dim rngFind As Range
Set rngFind = Columns("B:B").Find(what:="*" & "Joint1-" & num, After:=Range("B1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)

If Not rngFind Is Nothing Then
    Selection1 = rngFind.Row + 1
End If

Set rngFind = Columns("B:B").Find(what:="*Joint1-" & num + 1, After:=Range("B1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)

If Not rngFind Is Nothing Then
    Selection2 = rngFind.Row - 1
End If

If Selection1 > 0 And Selection2 > 0 Then
    Set SelectionRange = Range(Cells(Selection1, 2), Cells(Selection2, 6))
End If

End Sub

The intent here is that this should activate the detail sheet, find strings in column B which match "SomeTextHere(Joint1-1)" and select those rows. I then need it to paste those selections over to sheet 1 (below row 1, which has a value matching the "Joint" value in one of the columns), come back to sheet 2, select the rows containing "SomeTextHere(Joint1-2)" and paste those below the next row (after those which were just inserted). I realize that the pasting part of that is not in the code. This has been driving me nuts.

Please excuse my lack of knowledge in regards to VBA.

I'd like the finished product to look like a nested table kinda like follows:

               Original Items
Copied from sheet 2
Copied from sheet 2
Copied from sheet 2
               Original Item 2
Copied from sheet 2
etc.

Any help is greatly appreciated, thanks,

stobin stobin · Accepted Answer · 2013-10-17T23:39:34

I was a bit bored so I whipped up something that might help you. Let me know if it works for you.

Sub Macro1()

Dim i, j, x
Dim rng As Range
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Sheets("Syncrofit")
Set sh2 = Sheets("Detail")

lr = sh2.Range("B" & Rows.Count).End(xlUp).Row
lc = sh2.Cells(2, Columns.Count).End(xlToLeft).Column


j = 2
For y = 1 To 3 ' set upper limit of first integer in Joint string
    For x = 1 To 2 ' set upper limit of second integer in Joint string
        For i = 2 To lr
            If InStr(sh2.Cells(i, 2), "Joint" & y & "-" & x) <> 0 Then
                sh2.Range(sh2.Cells(i, 1), sh2.Cells(i, lc)).Copy
                sh1.Rows(j).Insert
                j = j + 1
            End If
        Next i
    Next x
Next y
End Sub

Excel VBA: Copy from one worksheet to another

1 Answers