How to copy multiple times repeating cells?

excel, vba

Solution

After looking at the comments, this will move N sets of data into a single set of columns. This assumes that each row contains data for one Name/ID combination, as in your example.

Sub moveData()

Dim x As Range
Dim data As Range
Dim i As Long
Dim origId As Range
Dim id As Range
Dim idColCount As Long
Dim setCount As Long
Dim setCol As Long
Dim headerRange As Range

Set headerRange = Range("1:1")
Set id = Range(Range("A2"), Range("B2").End(xlDown))
Set origId = id

idColCount = id.Columns.Count

setCount = Application.WorksheetFunction.CountIfs(headerRange, "salary")

setCol = 1
For i = 1 To setCount
  With headerRange
    Set x = .Find("Salary", .Cells(1, setCol))
    Set data = x.Offset(1).Resize(x.End(xlDown).Row - x.Row, 3)
    data.Copy
    id.Cells(1, 1).Offset(id.rows.Count, idColCount).PasteSpecial xlPasteAll
    origId.Copy
    id.Cells(1, 1).Offset(id.rows.Count).PasteSpecial xlPasteAll
    Set id = Range(id, id.End(xlDown))
  End With
  setCol = x.Column
Next i

setCol = 1
With headerRange
  Set x = .Find("Salary", .Cells(1, setCol))
  setCol = x.Column
  Set x = .Find("Salary", .Cells(1, setCol))
End With
Range(x, x.End(xlToRight).End(xlDown)).Clear

End Sub

Problem

I have a table ``` Name ID Salary Educ Exp Salary Educ Exp Mike 1 100 5 12 200 12 23 Peter 2 200 6 12 300 3 32 Lily 3 150 3 13 200 5 2 ................... ``` I need to transform this table into ``` Name ID Salary Educ Exp Mike 1 100 5 12 Peter 2 200 6 12 Lily 3 150 3 13 Mike 1 200 12 23 Peter 2 300 3 32 Lily 3 200 5 2 .................. ``` How can I do this using VBA ? Here is what I tried so far ``` Sub test() Dim rg1 As Range, rg2 As Range, rg3 As Range, shtDest As Worksheet Dim lLoop As Long, lRowDest As Long Set rg1 = Selection.Areas(1) Set rg2 = Selection.Areas(2) Set rg3 = Selection.Areas(3) Set shtDest = Worksheets.Add lRowDest = 1 For lLoop = 1 To rg1.Rows.Count lRowDest = lRowDest + rg2.Rows.Count + rg3.Rows.Count Next End Sub ```

Original source