macro to copy paste

[ariel_jaan]

Good day to all.

I have a problem with my worksheet.
Let me give you an example

BEFORE
Sheet 1
Column A
quick
brown
fox

jumps
over

AFTER
Sheet 2
Column A Column B Column C Column D Column E
quick brown fox
jumps over

Can someone help me with a macro for this? Basically the macro will only select the filled rows in Sheet 1 Column A and then paste it to Sheet 2 Column A but transpose though. Also, the next filled rows will then be copy paste to Sheet 2. If you notice the space in Column A Sheet 1 represents the row cut in Sheet 2. I have like 200 rows and 60 spaces manually doing the copy paste would feel like forever please someone great there please help me with my assignment.

Thanks a lot and good luck!!!

 

[hiker95]

ariel_jaan,

please help me with my assignment

I hope that this is not for a homework assignment.



Sample worksheets before the macro:

Excel Workbook
	A
1	quick
2	brown
3	fox
4
5	jumps
6	over
7
Sheet1

Excel Workbook
	A	B	C
1
2
3
Sheet2

After the macro:

Excel Workbook
	A	B	C
1	quick	brown	fox
2	jumps	over
3
Sheet2

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub ReorgData()
' hiker95, 05/16/2011
' http://www.mrexcel.com/forum/showthread.php?t=550246
Dim w1 As Worksheet, w2 As Worksheet
Dim Area As Range, NR As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
If Not Evaluate("ISREF(Sheet2!A1)") Then Worksheets.Add(After:=w1).Name = "Sheet2"
Set w2 = Worksheets("Sheet2")
NR = 1
For Each Area In w1.Range("A1", w1.Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With Area
    w2.Range("A" & NR).Resize(, .Rows.Count).Value = Application.Transpose(w1.Range("A" & .Row).Resize(.Rows.Count))
    NR = w2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
  End With
Next Area
w2.UsedRange.Columns.AutoFit
w2.Activate
Application.ScreenUpdating = True
End Sub

Then run the ReorgData macro.

 

[ariel_jaan]

wow! thanks for the quick reply i will test this later.

 

[ariel_jaan]

it worked! it really worked!

Thanks a lot.