Data Entered in Multiple Rows to One Column

[rashly]

Hello,

I have a rather large Excel document that was exported from an old database. The data contains 1 unique key (1) and 2 other data feilds (2, 3). However, the export was originally meant just for print reports, so instead of there being 3 columns with 3000 rows with the data going down, there are 90 columns with 33 or so rows.

So instead of (what I want):
1 2 3
1 2 3
1 2 3
1 2 3
1 2 3
1 2 3
1 2 3
1 2 3
1 2 3
1 2 3

The excel document contains (what it is):
1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3
1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3
1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3
1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3

Does anyone know of a macro or something that will make it so that every 3 columns will be cut and pasted under the first column? So coulmns 4-6 will be pasted under the last entried in column 1-3, columns 7-9 will be pasted under ther last entries of 1-3, etc.

Thank you for your help.

[anilsolipuram]

Backup your original workbook, before trying this macro

I am assuming Sheet1 contains the data, Shhet2 will contain the resulltant data.

start_row for processing data is row 2 and column is column A



Sub macro()
Dim start_row As Variant
Dim i, COL, K, RES_VAL, P_VAL As Variant
Dim sheet_name As Variant
Dim result_sheet As Variant
sheet_name = "Sheet1"
result_sheet = "Sheet2"
start_row = 2
SHEETS("Sheet1").select
i = 0
K = 0
COL = 1
RES_VAL = 1
P_VAL = start_row
While i = 0
If Range("a" & P_VAL).Value <> "" Then
While K = 0
If (Cells(P_VAL, COL).Value <> "") Then
Range(Cells(P_VAL, COL).Address & ":" & Cells(P_VAL, COL).Offset(0, 2).Address).Select
Selection.Copy
Sheets("Sheet2").Select
Range("a" & RES_VAL).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
COL = COL + 3
RES_VAL = RES_VAL + 1
Else
K = 1
End If
Wend
COL = 1
K = 0
Else
i = 1
End If
P_VAL = P_VAL + 1
Wend
End Sub

[rashly]

Thank you so much for your help.

I am getting an error on the following line:

Please Login or Register  to view this content.

Run-time error '1004':
Application-defined or object-defined error

Can someone point me in the right direction to why this error is coming up?

Thanks again.

[anilsolipuram]

As you know in the code sheet_name is data contained sheet, and result_sheet is the data copied sheet.

result sheet , is it a empty sheet or does it contain any data, it should be a empty sheet, or in the code you can assign result_sheet= empty sheet name


try this and let me know

Sub macro()
Dim start_row As Variant
Dim i, COL, K, RES_VAL, P_VAL As Variant
Dim sheet_name As Variant
Dim result_sheet As Variant
sheet_name = "Sheet1"
result_sheet = "Sheet2"
start_row = 2
i = 0
K = 0
COL = 1
RES_VAL = 1
P_VAL = start_row
While i = 0
If Range("a" & P_VAL).Value <> "" Then
While K = 0
If (Cells(P_VAL, COL).Value <> "") Then
Range(Cells(P_VAL, COL).Address & ":" & Cells(P_VAL, COL).Offset(0, 2).Address).Select
Selection.Copy
Sheets(result_sheet).Select
Range("a" & RES_VAL).Select
ActiveSheet.Paste
Sheets(sheet_name).Select
COL = COL + 3
RES_VAL = RES_VAL + 1
Else
K = 1
End If
Wend
COL = 1
K = 0
Else
i = 1
End If
P_VAL = P_VAL + 1
Wend
End Sub

[rashly]

Yeah, that second code that you posted worked great.

Thanks for all your help. It is much appreciated.