Last Column to first Column

[EMoe]

Hello!

Is it there a VBA code that can grab all the data from the last colum
on sheet 1, then paste it starting with the first or second column o
sheet 2. Go back to sheet 1and get the next to last column then past i
on the next column on sheet 2.

Thanks,
EMo

 

[Jim Cone]

Yes, code to do that can be created.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


"EMoe"
<[email protected]>
wrote in message Hello!
Is it there a VBA code that can grab all the data from the last column
on sheet 1, then paste it starting with the first or second column on
sheet 2. Go back to sheet 1and get the next to last column then past it
on the next column on sheet 2.
Thanks,
EMoe

 

[Joergen Bondesen]

Hi EMoe

Try this, please.


Option Explicit

'----------------------------------------------------------
' Procedure : Sheet1ToSheet2FlipColumns
' Date : 20060611
' Author : Joergen Bondesen
' Modifyed by :
' Purpose : Copy Sheet 1 to Sheet 2 and flip columns
' on sheet 2
' Note : Formula will be converted to Fixed value.
'----------------------------------------------------------
'
Sub Sheet1ToSheet2FlipColumns()
Dim x As Long
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim cell As Range

Application.ScreenUpdating = False

Set WS1 = Worksheets("Sheet1") 'From
Set WS2 = Worksheets("Sheet2") 'To

With WS2
.Cells.Clear

WS1.UsedRange.Copy _
Destination:=.Range("A1")

.Rows("1:1").Insert Shift:=xlDown

For x = 1 To .UsedRange.Columns.Count
.Cells(1, x).Value = .Cells(1, x).Column
Next x

'// Formula 2 Fixec value
For Each cell In .Cells.SpecialCells _
(xlCellTypeFormulas, 23)

cell.Value = cell.Value
Next cell

'// Sort
.UsedRange.Sort _
Key1:=.Range("A1"), _
Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, _
DataOption1:=xlSortNormal

.Rows("1:1").Delete Shift:=xlUp
End With

Set WS1 = Nothing
Set WS2 = Nothing
End Sub

 

[EMoe]

Thanks Joergen!

However I get an error on this line:

FOR EACH CELL IN .CELLS.SPECIALCELLS _
(XLCELLTYPEFORMULAS, 23

Also I've noticed that it pasted the info in the exact same order a
sheet1
but added the numbers 1 through 13 at the top
(I have 13 number columns)

Thanks,
EMo

 

[Joergen Bondesen]

Hi EMoe

I do not know what is wrong, sorry.
I am using Excel 2003 UK, and you are using?

You can either delete mentioned or you can start each line with an
apostrophe.
This "paragraphe" was to avoid problemes with formulas.
Do you have formulas in sheet 1?

' '// Formula 2 Fixec value
' For Each cell In .Cells.SpecialCells _
' (xlCellTypeFormulas, 23)
'
' cell.Value = cell.Value
' Next cell

Also I've noticed that it pasted the info in the exact same order as
sheet1

Yes, but later in the macro it will be sorted.

but added the numbers 1 through 13 at the top
(I have 13 number columns)

If you step through the macro you will notice that 1 to 13 => 13 to 1 and
later the row will be deleted.

 

[EMoe]

Thanks a bunch Joergen!
Sorry it took me so long to respond.

The code works fine.
I was trying to figure out though, when it places the values onto shee
2, where in the code can I tell it to start from the second column
instead of the first. I would like to reserve the first column fo
names.

But All In All; the code is what I am looking for.

Thanks again,
EMo

 

[Joergen Bondesen]

Hi Emoe

You are welcome.

Try this specialmade macro for you.
Now you can reserve x rows/ y columns.

Option Explicit

'Sheet2 Startcell *****
Const StartCellSh2 As String = "B3"

'----------------------------------------------------------
' Procedure : Sheet1ToSheet2FlipColumns
' Date : 20060614
' Author : Joergen Bondesen
' Modifyed by :
' Purpose : Copy Sheet 1 to Sheet 2 and flip columns
' on sheet 2
' Note : Formula will be converted to Fixed value.
' Fill in StartCellSh2 *****
'----------------------------------------------------------
'
Sub Sheet1ToSheet2FlipColumns()
Dim x As Long
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim cell As Range

Application.ScreenUpdating = False

Set WS1 = Worksheets("Sheet1") 'From
Set WS2 = Worksheets("Sheet2") 'To

With WS2
.Cells.Clear

WS1.UsedRange.Copy _
Destination:=.Range(StartCellSh2)

'// Sortrow insert
.Rows(.Range(StartCellSh2).Row).Insert Shift:=xlDown

For x = .Range(StartCellSh2).Column To _
.UsedRange.Columns.Count + .Range(StartCellSh2) _
.Column - 1

.Cells(.Range(StartCellSh2).Row, x).Value = _
.Cells(.Range(StartCellSh2).Row, x).Column
Next x

' '// Formula 2 Fixec value
' For Each cell In .Cells.SpecialCells _
' (xlCellTypeFormulas, 23)
'
' cell.Value = cell.Value
' Next cell

'// Sort
.UsedRange.Sort _
Key1:=.Range(StartCellSh2), _
Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, _
DataOption1:=xlSortNormal

'// Sortrow delete
.Rows(.Range(StartCellSh2).Row).Delete Shift:=xlUp

End With

Set WS1 = Nothing
Set WS2 = Nothing
End Sub