VBA and macros to copy values and insert into column (left to right)

[Legacy 485190]

Hi all,

I am having difficulties to use vba and macros, to copy values (rows of data) and paste as value into a column after it. I tried using Record macros but failed to get the result as the column that I need to select and copy from always changes.

This is the origin report :

		Test Cycle 1
1	Test 1	Pass
2	Test 2	Pass
3	Test 3	Pass
4	Test 4	Pass
5	Test 5	Pass

		Test Cycle 2
1	Test 1	Fail
2	Test 2	Pass
3	Test 3	Pass
4	Test 4	Pass
5	Test 5	Pass

		Test Cycle 3
1	Test 1	Fail
2	Test 2	Pass
3	Test 3	Pass
4	Test 4	Pass
5	Test 5	Pass

I need the result like this :

		Test Cycle 1	Test Cycle 2	Test Cycle 3	Test Cycle 4
1	Test 1	Pass	Fail	Pass	Pass
2	Test 2	Pass	Pass	Fail	Pass
3	Test 3	Pass	Pass	Pass	Pass
4	Test 4	Pass	Pass	Pass	Pass
5	Test 5	Pass	Pass	Pass	Pass

Can anyone help me ? I need to automate this process.

Thanks in advance.

 

[Zot]

The test results are on separate sheets or all the same sheet?

 

[Legacy 485190]

The test results are on separate sheets or all the same sheet?

All in the same sheet

 

[Zot]

Try this. I put the result on Sheet2

Sub Test()

Dim row As Long, col As Long
Dim rngRowFound As Range, rngResult As Range
Dim cell As Range, rngData As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")

Set rngData = ws1.Range("B1", ws1.Cells(Rows.Count, "B").End(xlUp))

For Each cell In rngData
    Select Case cell
        Case ""
        If cell.Offset(0, 1) Like "Test Cycle*" Then
            col = CLng(Trim(Split(cell.Offset(0, 1), "Test Cycle")(1))) + 2
            ws2.Cells(1, col) = cell.Offset(0, 1)
        End If
    Case Else
        Set rngResult = ws2.Range("B2", ws2.Cells(Rows.Count, "B").End(xlUp))
        If rngResult.row = 1 Then Set rngResult = ws2.Range("B2")
        Set rngRowFound = rngResult.Find(cell.Value, LookAt:=xlWhole)
        If rngRowFound Is Nothing Then
            row = ws2.Cells(Rows.Count, "B").End(xlUp).Offset(1).row
            With ws2.Cells(row, col - 1)
                .Value = cell
                .Offset(0, 1) = cell.Offset(0, 1)
            End With
        Else
            With ws2.Cells(rngRowFound.row, col)
                .Value = cell.Offset(0, 1)
            End With
        End If
    End Select
Next

End Sub

 

[Legacy 485190]

Try this. I put the result on Sheet2

Sub Test()

Dim row As Long, col As Long
Dim rngRowFound As Range, rngResult As Range
Dim cell As Range, rngData As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")

Set rngData = ws1.Range("B1", ws1.Cells(Rows.Count, "B").End(xlUp))

For Each cell In rngData
    Select Case cell
        Case ""
        If cell.Offset(0, 1) Like "Test Cycle*" Then
            col = CLng(Trim(Split(cell.Offset(0, 1), "Test Cycle")(1))) + 2
            ws2.Cells(1, col) = cell.Offset(0, 1)
        End If
    Case Else
        Set rngResult = ws2.Range("B2", ws2.Cells(Rows.Count, "B").End(xlUp))
        If rngResult.row = 1 Then Set rngResult = ws2.Range("B2")
        Set rngRowFound = rngResult.Find(cell.Value, LookAt:=xlWhole)
        If rngRowFound Is Nothing Then
            row = ws2.Cells(Rows.Count, "B").End(xlUp).Offset(1).row
            With ws2.Cells(row, col - 1)
                .Value = cell
                .Offset(0, 1) = cell.Offset(0, 1)
            End With
        Else
            With ws2.Cells(rngRowFound.row, col)
                .Value = cell.Offset(0, 1)
            End With
        End If
    End Select
Next

End Sub

It shows that the line "With ws2.Cells (row, col - 1)" has application-defined or object-defined error.

 

[maabadi]

It shows that the line "With ws2.Cells (row, col - 1)" has application-defined or object-defined error.

if your workbook don't have Sheet2, Add new sheet and name it Sheet2
Or Change Sheet2 at VBA Code to one of Empty sheets within Workbook.

 

[Legacy 485190]

if your workbook don't have Sheet2, Add new sheet and name it Sheet2
Or Change Sheet2 at VBA Code to one of Empty sheets within Workbook.

I have the Sheet2 in my workbook but it still cant work.

 

[Zot]

I have the Sheet2 in my workbook but it still cant work.

Maybe you are referring to index Sheet2 but not the name of the sheet. My code was refering to sheet name, Sheet2. See example below
The index is Sheet2 but the sheet name is BOM

 

[Zot]

If you want to use index, then need to change to

Set ws1 = ActiveWorkbook.Sheets(1)
Set ws2 = ActiveWorkbook.Sheets(2)

 

[Legacy 485190]

Maybe you are referring to index Sheet2 but not the name of the sheet. My code was refering to sheet name, Sheet2. See example below
The index is Sheet2 but the sheet name is BOM

But my sheet name is also Sheet2