PDA

View Full Version : Solved: Copy last 6 columns



dgt
10-23-2010, 04:19 PM
Hi all

I created a macro (see below) to copy the last 6 filled columns of a worksheet to the next available 6 columns.



Sub CopyCols()
Columns("DD:DI").Select
Range("DD3").Activate
Selection.Copy
Range("DJ1").Select
ActiveSheet.Paste
Range("DP1").Select
End Sub


However, using it in this format means changing the cell references, every time I run it. I need the macro to be able to select and copy the last 6 filled columns and then paste these columns into the next (adjoining) 6 empty columns.

The other problem with the above macro is that it still shows the message "select destination & press ENTER or choose paste" even though the columns have actually been pasted in.

TIA ...David

Paul_Hossler
10-23-2010, 05:00 PM
Maybe


Option Explicit
Sub Last6()
Dim rFirst As Range, rLast As Range
Application.ScreenUpdating = False
Set rLast = ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft)
Set rFirst = rLast.Offset(0, -5)

Call Range(rFirst, rLast).EntireColumn.Copy(rLast.Offset(0, 1))
Application.ScreenUpdating = True
End Sub


Paul

dgt
10-23-2010, 06:49 PM
Hi Paul

Thanks for the suggested code.

I thought that I would give it a quick try but not quite working correctly, as it pastes the 6 cols in the wrong sequence, best explained as:

Copying last 6 cols in this order: 1, 2, 3, 4, 5, 6
but pasting them in this order: 2, 3, 4, 5, 6, 1

Not sure of the obvious answer as I have very limited knowledge of VBA but will try to play around with your code tomorrow.

Regards ...David

Paul_Hossler
10-23-2010, 07:21 PM
Sorry, but I'm not seeing that in the data I was using to test

There are some assumptions I made, the biggest one is that row 1 determines the right most cell to mark the end of data. You might have to change the row used in the .End if you have a different structure

Otherwise, an example would help

Paul

mbarron
10-23-2010, 08:15 PM
David,
Unless there is something I'm misinterpreting as well, Paul's code should do what you asked. In order to move the data as you've shown, there would have to be two different copy / paste events.

Here is a slightly different approach.
Sub last6_mdbct()
Application.ScreenUpdating = False
Cells(1, Columns.Count).End(xlToLeft).Offset(0, -5).Resize(Rows.Count, 6).Copy _
Destination:=Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
Application.ScreenUpdating = True
End Sub


The other problem with the above macro is that it still shows the message "select destination & press ENTER or choose paste" even though the columns have actually been pasted in. This is because you used used the Paste command - the same method as if doing it manually instead of using a macro. To turn off the 'marching ants' (and the message you've detailed) use the following line after your AciveSheet.Paste
Application.CutCopyMode = False

dgt
10-24-2010, 03:59 AM
Hi Paul

Not really sure what the problem is, unless it is something to do with the formatting of Row 1 or even the mammoth amount of formulas within the sheet. Just for the record, when these 6 columns are copied to the next empty 6 columns; all formulas etc will update themselves automatically, when the document is saved.

I have created a test file; in which the "Before" sheet is how the data would look before copying; however when I run the Macro on this sheet it comes up with a 'compile' error on the line:



Set rFirst = rLast.Offset(0, -5)


and I can only assume this is something to do with the data being in the first 6 columns of the worksheet.

I then created the "After" sheet; where I manually added the second set of 6 columns and then ran the macro; which resulted in the columns being out of order, as you can see from the "After" worksheet.

Hope this helps ...David

PS: MBarron, just seen your post as I replied to Paul, will test this solution later today ...thanks

dgt
10-24-2010, 04:10 AM
Hi MBarron

I thought I would test the code whilst I was still online but having similar problems with your code as well.

When I run the macro on the "Before" sheet it also comes up with a compile error on:



Cells(1, Columns.Count).End(xlToLeft).Offset(0, -5).Resize(Rows.Count, 6).Copy _
Destination:=Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)


and when I run it on the "After" sheet, the columns are also pasted with the first column at the end, instead of at the beginning.

I reckon it must be something to do with the formatting of the columns but don't know how to correct the code to take this into account.

Regards ...David

mdmackillop
10-24-2010, 04:28 AM
Did you take account of this statement in Post 4?



There are some assumptions I made, the biggest one is that row 1 determines
the right most cell to mark the end of data. You might have to change the row
used in the .End if you have a different structure

mbarron
10-24-2010, 05:14 AM
Da#& you Merged Cells!!!!! This is another example of why merged cells are evil and why it's always best to post a sample workbook.

Try this version of Paul's macro.

Sub CopyLast6()
Dim rFirst As Range, rLast As Range
Application.ScreenUpdating = False
Set rLast = ActiveSheet.Cells(3, ActiveSheet.Columns.Count).End(xlToLeft)
Set rFirst = rLast.Offset(0, -5)

Call Range(rFirst, rLast).EntireColumn.Copy(rLast.Offset(-2, 1))
Application.ScreenUpdating = True
End Sub

dgt
10-24-2010, 05:24 AM
After mdmackillop posted his comment, I did realise that the merged cells were causing the problem.

I amended the line as you did:



Set rLast = ActiveSheet.Cells(3, ActiveSheet.Columns.Count).End(xlToLeft)


but it still did not work. Your revised code works great and I can now see where the second amendment was needed.

Thanks again to everyone ...David

Paul_Hossler
10-24-2010, 06:13 AM
I'm 'sure' merged cells have their uses, but they can sure mess up and complicate code.

Just in case you ever want to use this on non-merged ranges, you can 'sort of' easily handle merged cells


Sub CopyLast6_v3()
Dim rLast As Range, rFirst As Range

Application.ScreenUpdating = False

Set rLast = ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft)
If rLast.MergeCells Then
Call rLast.MergeArea.EntireColumn.Copy(rLast.MergeArea.Offset(0, 1))
Else
Set rFirst = rLast.Offset(0, -5)
Call Range(rFirst, rLast).EntireColumn.Copy(rLast.Offset(0, 1))
End If

Application.ScreenUpdating = True
End Sub


Paul

dgt
10-25-2010, 05:43 PM
Hi Paul

Thanks for the additional code, I have retained thast for future use.

Regards ...David