VBA Copy and Paste

S

Shamos

New Member
Joined
Jun 27, 2013
Messages
11
Hi,

My ability using Macro's is limmited so please excuse the bad code!

I'm trying to use VBA to transpose and paste data from one sheet to another.

I can get the first row and the start of the second as B:B will always have data, however C:C may have blank cells depending on the avaliable options.

How do I get C:C to align / start where Range("B:B").Find(""). starts?

How do I get my code to drop down a row on sheet one till it hits a blank?

Thanks

Sub shauns_1()
'

Application.DisplayAlerts = False

Sheets("Selectable Options").Select
'Range("A2").Select
'Selection.Copy
'Sheets("Sheet2").Select
'Range("A1").Select
'ActiveSheet.Paste
Sheets("Selectable Options").Rows("1:1").Select
'Rows("1:1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Selectable Options").Select
Rows("2:2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("C1").Select
Sheets("Selectable Options").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Columns("C:C").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Selectable Options").Select
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("B:B").Find("").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Selectable Options").Select
Rows("3:3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("B:B").Find("").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
I would like to change:
[TABLE="width: 1975"]
<TBODY>[TR]
[TD]Model base[/TD]
[TD]Option Code[/TD]
[TD]Option Description[/TD]
[TD]Manufacturer Option Code[/TD]
[TD]Auto Fit[/TD]
[TD]Selectable Option[/TD]
[TD]Price[/TD]
[TD]Ex Factory[/TD]
[TD]Option Rules[/TD]
[TD]GB Comments?[/TD]
[/TR]
[TR]
[TD]Sail1[/TD]
[TD]1[/TD]
[TD]boat[/TD]
[TD]10[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]180[/TD]
[TD="align: right"]72[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Sail2[/TD]
[TD]2[/TD]
[TD]boat[/TD]
[TD]11[/TD]
[TD][/TD]
[TD][/TD]
[TD]180[/TD]
[TD="align: right"]72[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Sail3[/TD]
[TD]3[/TD]
[TD]boat[/TD]
[TD]13[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]180[/TD]
[TD="align: right"]72[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Sail4[/TD]
[TD]4[/TD]
[TD]boat[/TD]
[TD]14[/TD]
[TD][/TD]
[TD]y[/TD]
[TD]?[/TD]
[TD="align: right"]234[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Sail5[/TD]
[TD]5[/TD]
[TD]boat[/TD]
[TD]15[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]234[/TD]
[TD="align: right"]113[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Sail6[/TD]
[TD]6[/TD]
[TD]boat[/TD]
[TD]16[/TD]
[TD][/TD]
[TD][/TD]
[TD]234[/TD]
[TD="align: right"]113[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Sail7[/TD]
[TD]7[/TD]
[TD]boat[/TD]
[TD]17[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]234[/TD]
[TD="align: right"]113[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Sail8[/TD]
[TD]8[/TD]
[TD]boat[/TD]
[TD]18[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]234[/TD]
[TD="align: right"]113[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Sail9[/TD]
[TD]9[/TD]
[TD]boat[/TD]
[TD]19[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]234[/TD]
[TD="align: right"]113[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Big Wheel 1[/TD]
[TD]10[/TD]
[TD]bike[/TD]
[TD]20[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]718[/TD]
[TD="align: right"]302[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Big Wheel 2[/TD]
[TD]11[/TD]
[TD]bike[/TD]
[TD]21[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]718[/TD]
[TD="align: right"]302[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Big Wheel 3[/TD]
[TD]12[/TD]
[TD]bike[/TD]
[TD]22[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]718[/TD]
[TD="align: right"]302[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Big Wheel 4[/TD]
[TD]13[/TD]
[TD]bike[/TD]
[TD]23[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]718[/TD]
[TD="align: right"]302[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Big Wheel 5[/TD]
[TD]14[/TD]
[TD]bike[/TD]
[TD]24[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]3422[/TD]
[TD="align: right"]1643[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Big Wheel 6[/TD]
[TD]15[/TD]
[TD]bike[/TD]
[TD]25[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]2918[/TD]
[TD="align: right"]1401[/TD]
[TD]invalid[/TD]
[TD][/TD]
[/TR]
</TBODY><COLGROUP><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL></COLGROUP>[/TABLE]

To:
[TABLE="width: 347"]
<TBODY>[TR]
[TD]Model base</SPAN>[/TD]
[TD]Sail1</SPAN>[/TD]
[/TR]
[TR]
[TD]Option Code</SPAN>[/TD]
[TD]1</SPAN>[/TD]
[/TR]
[TR]
[TD]Option Description</SPAN>[/TD]
[TD]boat</SPAN>[/TD]
[/TR]
[TR]
[TD]Manufacturer Option Code</SPAN>[/TD]
[TD]10</SPAN>[/TD]
[/TR]
[TR]
[TD]Auto Fit</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Selectable Option</SPAN>[/TD]
[TD]Y</SPAN>[/TD]
[/TR]
[TR]
[TD]Price</SPAN>[/TD]
[TD]180</SPAN>[/TD]
[/TR]
[TR]
[TD]Ex Factory</SPAN>[/TD]
[TD="align: right"]72[/TD]
[/TR]
[TR]
[TD]Option Rules</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]GB Comments?</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Model base</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Option Code</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Option Description</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Manufacturer Option Code</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Auto Fit</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Selectable Option</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Price</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Ex Factory</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Option Rules</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]GB Comments?</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Model base</SPAN>[/TD]
[TD]Sail2</SPAN>[/TD]
[/TR]
[TR]
[TD]Option Code</SPAN>[/TD]
[TD]2</SPAN>[/TD]
[/TR]
[TR]
[TD]Option Description</SPAN>[/TD]
[TD]boat</SPAN>[/TD]
[/TR]
[TR]
[TD]Manufacturer Option Code</SPAN>[/TD]
[TD]11</SPAN>[/TD]
[/TR]
[TR]
[TD]Auto Fit</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Selectable Option</SPAN>[/TD]
[TD]Y</SPAN>[/TD]
[/TR]
[TR]
[TD]Price</SPAN>[/TD]
[TD]180</SPAN>[/TD]
[/TR]
[TR]
[TD]Ex Factory</SPAN>[/TD]
[TD="align: right"]72</SPAN>[/TD]
[/TR]
[TR]
[TD]Option Rules</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]GB Comments?</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Model base</SPAN>[/TD]
[TD][/TD]
[/TR]
</TBODY><COLGROUP><COL><COL></COLGROUP>[/TABLE]
 
Upvote 0
Give this a try:

(use this code on test data first)

Code: 
Sub example()
 Dim ary() As Variant
 finalcol = cells(1, Columns.Count).End(xlToLeft).Column
 finalrow = cells(Rows.Count, 1).End(xlUp).Row
 ary() = Range(cells(1, 1), cells(finalrow, finalcol))
 xt = Application.WorksheetFunction.Transpose(ary())
 Range(cells(1, 1), cells(finalrow, finalcol)).ClearContents
 Range(cells(1, 1), cells(finalcol, finalrow)) = xt
End Sub
 
Upvote 0
Thank you so much for your help,

I'm not sure if I'm using the asistance you have given correctly.
I have entered the code before the original code I have put together and by it's self but get
Run-time error '13': Type mismatch at line ary() = Range (Cells(1, 1), Cells (finalrow, finalcol))

Thank you once again.
 
Upvote 0
I just changed from open explicit and the code works very well Thanks!:)
What I would like to do is "stack the data" i.e. in the example above the example the columns start at model base and end at GB comments.

For each model base i.e. sail1 I would like to transpose the first row into column "B" and place the data for that model in column "C" then repeat for the next model under the first untill all of the data has been entered.

I know this is a lot to ask, but any help is appreciated.
</SPAN>
 
Upvote 0
Sorry, I didn't see that the first time. this should work for you:

test it out before you use it though..

Code: 
Sub transposeArray()
 Dim ary() As Variant
 finalcol = cells(1, Columns.Count).End(xlToLeft).Column
 finalrow = cells(Rows.Count, 1).End(xlUp).Row
 ary() = Range(cells(1, 1), cells(finalrow, finalcol))
 xt = Application.WorksheetFunction.Transpose(ary())
 ary() = Range(cells(1, 1), cells(1, finalcol))
 Range(cells(1, 1), cells(finalrow, finalcol)).ClearContents
 Range(cells(1, 2), cells(finalcol, finalrow + 1)) = xt
 finalcol = cells(1, Columns.Count).End(xlToLeft).Column
 finalrow = cells(Rows.Count, 2).End(xlUp).Row
 xt = Range(cells(1, 2), cells(finalrow, 2))
 i = 4
 Do
    finalrow = cells(Rows.Count, 2).End(xlUp).Row
    Range(cells(finalrow + 1, 2), cells(finalrow + 10, 2)) = xt
    currentrow = cells(Rows.Count, i).End(xlUp).Row
    ng = Range(cells(1, i), cells(currentrow, i))
    Range(cells(finalrow + 1, 3), cells(finalrow + currentrow, 3)) = ng
    i = i + 1
 Loop Until i = finalcol + 1
 Range(cells(1, 4), cells(finalrow, finalcol)).ClearContents
End Sub
 
Upvote 0
Thank you for your time and assistance with this. It works fantastically
I have been trying to work out some code for weeks.
I’m very grateful</SPAN>
 
Upvote 0
Sorry to be a pain,

looking through the results the code stacks the data well, but after the first data set it only stacks the first 10 columns worth of data. I thought it might be because of the clear contents so I commented these out but it made no difference.
Do you think I might be better pasting the results on another sheet so it always has a reference till it finishes?</SPAN>

Thanks
 
Last edited:
Upvote 0
You're not a pain, you're keeping me honest!! I made little mistake on a line. I fixed the error and tested it. this should work for you. I had a constant of 10 before, and now its a variable. I tested it with different amounts of columns and rows. it should work for you now. let me know if you have any other problems.

Code: 
Sub transposeArray()
 Dim ary() As Variant
 finalcol = cells(1, Columns.Count).End(xlToLeft).Column
 startrow = cells(Rows.Count, 1).End(xlUp).Row
 ary() = Range(cells(1, 1), cells(startrow, finalcol))
 xt = Application.WorksheetFunction.Transpose(ary())
 ary() = Range(cells(1, 1), cells(1, finalcol))
 Range(cells(1, 1), cells(startrow, finalcol)).ClearContents
 Range(cells(1, 2), cells(finalcol, startrow + 1)) = xt
 finalcol = cells(1, Columns.Count).End(xlToLeft).Column
 startrow = cells(Rows.Count, 2).End(xlUp).Row
 xt = Range(cells(1, 2), cells(startrow, 2))
 i = 4
 Do
    finalrow = cells(Rows.Count, 2).End(xlUp).Row
    Range(cells(finalrow + 1, 2), cells(finalrow + startrow, 2)) = xt
    currentrow = cells(Rows.Count, i).End(xlUp).Row
    ng = Range(cells(1, i), cells(currentrow, i))
    Range(cells(finalrow + 1, 3), cells(finalrow + currentrow, 3)) = ng
    i = i + 1
 Loop Until i = finalcol + 1
 Range(cells(1, 4), cells(finalrow, finalcol)).ClearContents
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
Increasing row before the macro runs again
Replies
1
Views
211
kbk
K
willow1985
  • Solved
VBA Run-time error 91 - Object variable or With block variable not set when trying to refresh data/Sleep
Replies
4
Views
280
willow1985
willow1985
C
  • Question Question
Please help clean up my convoluted VBA code. It seems very redundant and repetitive.
Replies
1
Views
429
myall_blues
myall_blues
D
  • Solved
extract to another workbook and save using desktop path
2
Replies
12
Views
191
jolivanes
jolivanes
N
  • Question Question
Adding to an existing MACRO
Replies
2
Views
103
Northern NY Design
N

Forum statistics

Threads
1,223,886
Messages
6,175,196
Members
452,616
Latest member
intern444

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top