Code Help

[waldos]

Hello, Im trying to learn VB codeing but with the hours spent getting nowhere I could have linked all the cells.Hopefully I will benefit in the future.
I have a sheet with 80 columns. Every 2nd column sums to the same row. I wish to copy this row to sheet2 but have them displayed vertically ie;A1:A40 without any gaps. I have tried the following but:
Example:
Sub Copyone()
Sheets("Sheet1").Select
Range("C12,E12,G12,I12,K12,M12").Select

Selection.Copy

Sheets("Sheet2").Select
Range("B1:B6").Select

ActiveSheet.Paste
End Sub

But I have to enter 40 Ranges for sheet 1 indvidually - any easier way and when it pastes down it does so but in 6 columns wide as well.
It pastes horizontally alright. Do I need to paste horizontally to a hidden sheet and then convert from this to vertically.
Any guidence would be appreciated.
Thank You.

 

[Joe Was]

You must un-hide the sheet to copy to it, then re-hide the sheet. JSW

 

[NateO]

Howdy Waldos.

Do I need to paste horizontally to a hidden sheet and then convert from this to vertically.

Nope, you can use the transpose part of pastespecial to help you flip this data without using extra sheets, etc..

Here's an example based of your code:

<pre>
Sub Copyone()
Application.ScreenUpdating = False
Sheets(1).Range("C12,E12,G12,I12,K12,M12").Copy
Sheets(2).Range("B1").PasteSpecial Transpose:=True
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub</pre>

 

[Ivan F Moala]

Hellow Waldos

Another Kiwi ?!

You say you have 80 columns of data columns
to copy over....further to Nate O's Transpose
give this a go....just define the entire
range (See code).....this should save you
manually inputting the addresses.....

<pre/>
Sub Tester()
'// Testing xl2000/win98
Dim x As Single
Dim sCopyRg As String
Dim rSelection As Range

Sheets("Sheet1").Select
'// Define your Whole range here
'// ie. Start range address - Finish range address
Set rSelection = Range("C12:AG12")

With rSelection
'// Build the String range address here
For x = 1 To rSelection.Count Step 2
sCopyRg = rSelection(x).Address & "," & sCopyRg
Next
End With

'// Remove last "," and Copy
Range(Left(sCopyRg, Len(sCopyRg) - 1)).Copy

Sheets("Sheet2").Range("A1").PasteSpecial Transpose:=True
Application.CutCopyMode = False

End Sub
</pre>

 

[NateO]

Ivan's code works well. A few pointers (since it was asked):

1: Change Sheet2 to the name of your target sheet. You'll get an error if you incorrectly identify your sheet.

2: Change the copy range appropriately.

Tested and smokin' hot in 'xl 97.

Kudos Ivan & cheers y'all,

Nate
This message was edited by NateO on 2002-07-17 00:31

 

[Dave Hawley]

Hi Waldos

Here is another way:

Sub Copyone()
With Sheets("Sheet1")
    .Rows(12).EntireRow.Insert
    .Range("C12:AG12").FormulaR1C1 = "=IF(MOD(COLUMN(),2)<>0,R[1]C,"""")"
    .Range("C12:AG12") = .Range("C12:AG12").Value
    .Range("C12:AG12").Copy
End With
With Sheets("Sheet2")
      .Range("B1").PasteSpecial Transpose:=True
      Application.CutCopyMode = False
     .Range("B1", .Range("B65536").End(xlUp)).Sort _
      Key1:=.Range("B1"), Order1:=xlAscending, Header:=xlNo, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
Sheets("Sheet1").Rows(12).EntireRow.Delete
End Sub

The sort is used to get rid of any blanks
_________________
Regards
Dave Hawley
8 Add-ins 1, with free File Size Reducer
40+ more here
OzGrid.com
This message was edited by Dave Hawley on 2002-07-17 00:48

 

[waldos]

Hello Ivan
Thank you for the code the other day.
I am unable to get it working.I keep getting
'Method Range of Object Global Failed'
on the line
Range(Left(sCopyRg,Len(sCopyRg)-1)).Copy

The target sheet 2 is correct. I've checked my cut and paste agains't your original and it checks okay.
I'm stumped any idea's
Iv'e just read the board
Happy B=Day Ivan
This message was edited by waldos on 2002-07-19 01:54

 

[waldos]

Got it Ivan
In the 'range select' it works fine out to column BY but as soon as I go to column CA,or CC it throws up the error.