Help with Excel Macro

[vidyashankara]

I am new to excel and I need to make a macro that reads data from Sheet1 and pastes it into sheet2 successively.

This is how my sheet one looks..

A1 10 1249
A2 13 1232
A3 21 2312
.
.
.
A1 402 12212
A2 432 23323
A3 442 23232
.
.
.

I need Sheet 2 to look like this

A1 10 1249 A2 13 1232 A3 21 2312 . . .
A1 402 12212 A2 432 23323 A3 442 23232 . . . .
.
.
.

How do I write a macro for this? I recorded it using the recorder, and it works only for the first couple of values...

 

[vidyashankara]

No, there aren't..

 

[Redwolfx]

Try

Sub Format()
Dim MyCell As Range
Dim Mycell2 As Range
Dim LastRow As Long
Dim LastRow2 As Long
Dim Col As Long
LastRow = Sheets("Sheet1").Range("A100000").End(xlUp).Row
LastRow2 = 1
Col = 1

    For Each MyCell In Sheets("Sheet1").Range("A1:A" & LastRow)
        With Sheets("Sheet2")
        
        LastRow2 = Sheets("Sheet2").Range("A100000").End(xlUp).Row
         
                If Left(MyCell.Value, 3) = "A1 " Then
                   LastRow2 = LastRow2 + 1
                   Col = 1
                End If
            .Cells(LastRow2, Col + 0).Value = MyCell.Value
            .Cells(LastRow2, Col + 1).Value = MyCell(1, 2).Value
            .Cells(LastRow2, Col + 2).Value = MyCell(1, 3).Value
            
            Col = Col + 3
        End With
    Next MyCell
End Sub

 

[vidyashankara]

Same thing... It copies the first row which is shown below and stops
,

Item

Time (s)

Normalized Intensity (Cnt/s),

<tbody>
</tbody>

 

[Redwolfx]

Try This:

Don't change Anything

Sub Format()
Dim MyCell As Range
Dim Mycell2 As Range
Dim LastRow As Long
Dim LastRow2 As Long
Dim Col As Long
LastRow = Sheets("Sheet1").Range("A7946").End(xlUp).Row
LastRow2 = 1
Col = 1

    For Each MyCell In Sheets("Sheet1").Range("A2:A" & LastRow)
        With Sheets("Sheet2")
        
        LastRow2 = Sheets("Sheet2").Range("A7946").End(xlUp).Row
         
                If Left(MyCell.Value, 3) = "A1 " Then
                   LastRow2 = LastRow2 + 1
                   Col = 1
                End If
            .Cells(LastRow2, Col + 0).Value = MyCell.Value
            .Cells(LastRow2, Col + 1).Value = MyCell(1, 2).Value
            .Cells(LastRow2, Col + 2).Value = MyCell(1, 3).Value
            
            Col = Col + 3
        End With
    Next MyCell
End Sub

 

[Redwolfx]

Your last row is actually 7945 When you put an xlup it looks for the first last blank cell in the range you give it. If that range contains no blanks, it reverts to 1

 

[vidyashankara]

It works, but there is a new problem. It goes left till row (IV) till H2, and then stops.. (end of worksheet or some sort of excel limit on the number of columns?

Also, it does not copy and paste the second set of A1-H12 data on the second row..

 

[vidyashankara]

I get an error saying application or object defined error when I run the macro, highlighting this line

.Cells(LastRow2, Col + 1).Value = MyCell(1, 2).Value

 

[vidyashankara]

I fixed it by remove the reduntant Well name like A1 - 60 C etc... But now it overwrites the second set of data over the first set of data.. How do I move it to the next row?

 

[Redwolfx]

What version of Excel are you using?

 

[vidyashankara]

Excel 2010... I changed the code to remove the well name, so it fits in the number of columns... But the macro keeps replacing the first row of data with the newer ones...

This is the code i have now,

Sub DLS_Kinectic()
Dim MyCell As Range
Dim Mycell2 As Range
Dim LastRow As Long
Dim LastRow2 As Long
Dim Col As Long
LastRow = Sheets("Sheet1").Range("A7946").End(xlUp).Row
LastRow2 = 1
Col = 1


    For Each MyCell In Sheets("Sheet1").Range("A2:A" & LastRow)
        With Sheets("Sheet2")
        
        LastRow2 = Sheets("Sheet2").Range("A7946").End(xlUp).Row
         
                If Left(MyCell.Value, 3) = "A1" Then
                   LastRow2 = LastRow2 + 1
                   Col = 1
                End If
            .Cells(LastRow2, Col + 1).Value = MyCell(1, 2).Value
            .Cells(LastRow2, Col + 2).Value = MyCell(1, 3).Value
            
            Col = Col + 2
        End With
    Next MyCell
End Sub