Copy from one workbook to another but only certain columns

[paulstan]

My problem is that I need to copy data from workbook1 to workbook2 where the layouts are completely different.

I would like to select rows in workbook1 and then run a macro to copy these to workbook2; however, I would like to copy columns from workbook1, for example, C F A D H B J E and have them appear in the order A B C D E F G H on workbook2 (so Col C in book1 would go in Col A in book2, Col F in book1 would go in Col B in book2 and so on…). Number of rows is unknown.

To make it slightly easier both workbooks can be open at the same time.

The only alternative would be to change the layout in workbook1 to exactly match workbook2, but this is really the last resort.

Many thanks in advance from a complete novice.

Paul S

 

[VoG]

Hello. Have you tried recording a macro?

 

[paulstan]

Peter

Thank you for your reply. Will I be able to record a macro if the number of rows is an unknown (could be 1 or a 100, depending what is selected from a filter)?

Thanks

Paul S

 

[VoG]

The macro recorder will capture exactly what you did. If you post the recorded code here we can probably adapt it for any number of rows.

 

[paulstan]

First ever go at recording a macro so please excuse my ignorance. Hopefully, the code is understandable by powers greater than I but, in a nutshell, I have done the following:
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
Opened up 2 workbooks named: ‘FromThis’ and ‘ToThis’. I want to copy the cells as follows (‘FromTo’ first: ‘ToThis’ second): A-E, B-D, C-C, E-A, G-F, H-G
<o></o>
I have run it a few times and all seems ok, much to my surprise. Now, this works fine on one row (namely row 2). What I would like though is for a selected area to be copied (not necessarily contiguous) for example if an auto-filter has selected rows 5,7,12,19,25, then user selects all these and copies them across en-masse.

Many Thanks

Paul S
<o></o>

Sub COPY()
'
' COPY Macro
'
'
    Range("A2").Select
    Selection.COPY
    Windows("ToThis.xlsm").Activate
    Sheets("TEST").Select
 
    Range("E2").Select
    ActiveSheet.Paste
    Windows("FromThis.xlsm").Activate
    Sheets("Sheet1").Select
 
    Range("B2").Select
    Application.CutCopyMode = False
    Selection.COPY
    Windows("ToThis.xlsm").Activate
    Sheets("TEST").Select
 
    Range("D2").Select
    ActiveSheet.Paste
    Windows("FromThis.xlsm").Activate
    Sheets("Sheet1").Select
 
    Range("C2").Select
    Application.CutCopyMode = False
    Selection.COPY
    Windows("ToThis.xlsm").Activate
    Sheets("TEST").Select
 
    Range("C2").Select
    ActiveSheet.Paste
    Windows("FromThis.xlsm").Activate
    Sheets("Sheet1").Select
 
    Range("E2").Select
    Application.CutCopyMode = False
    Selection.COPY
    Windows("ToThis.xlsm").Activate
    Sheets("TEST").Select
 
    Range("A2").Select
    ActiveSheet.Paste
    Windows("FromThis.xlsm").Activate
    Sheets("Sheet1").Select
 
    Range("G2").Select
    Application.CutCopyMode = False
    Selection.COPY
    Windows("ToThis.xlsm").Activate
    Sheets("TEST").Select
 
    Range("F2").Select
    ActiveSheet.Paste
    Windows("FromThis.xlsm").Activate
    Sheets("Sheet1").Select
 
    Range("H2").Select
    Application.CutCopyMode = False
    Selection.COPY
    Windows("ToThis.xlsm").Activate
    Sheets("TEST").Select
    Range("G2").Select
    ActiveSheet.Paste
 
    Windows("ToThis.xlsm").Activate
    Sheets("TEST").Select
    Range("A3").Select
End Sub

 

[VoG]

Here's a simplified and hopefully faster version. If you were copying multiple rows would they be pasted in starting at row 2?

Sub MyCOPY()
'
' COPY Macro
'
'
    Range("A2").COPY Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("E2")
    Range("B2").COPY Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("D2")
    Range("C2").COPY Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("C2")
    Range("E2").COPY Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("A2")
    Range("G2").COPY Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("F2")
    Range("H2").COPY Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("G2")
    Application.CutCopyMode = False
End Sub

 

[paulstan]

Peter,

Thank you. Your method is much more streamlined and easier to understand.

My original file is at work and I'm working on a mock-up at home, but I believe the paste will start at row 6.

Also, the copy/paste may need to be done on different filters so data would have to be appended to previous copy/pastes on the 'ToThis' workbook.

Many Thanks

Paul S

 

[VoG]

Try this

Sub MyCOPY()
'
' COPY Macro
'
'
Dim LR As Long, LR2 As Long
LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
LR2 = WorksheetFunction.Max(6, Workbooks("ToThis.xlsm").Sheets("TEST").Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row + 1)
Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).COPY Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("E" & LR2)
Range("B2:B" & LR).SpecialCells(xlCellTypeVisible).COPY Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("D" & LR2)
Range("C2:C" & LR).SpecialCells(xlCellTypeVisible).COPY Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("C" & LR2)
Range("E2:E" & LR).SpecialCells(xlCellTypeVisible).COPY Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("A" & LR2)
Range("G2:G" & LR).SpecialCells(xlCellTypeVisible).COPY Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("F" & LR2)
Range("H2:H" & LR).SpecialCells(xlCellTypeVisible).COPY Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("G" & LR2)
Application.CutCopyMode = False
End Sub

 

[paulstan]

Peter

That is nigh perfect and exactly what I've been after.

Afterthought: is it feasible that if there was no auto-filter and the user wanted to CTRL-click their selection could they just copy those selected records?

Many Thanks

Paul S

 

[VoG]

OK, no need to CTRL + click. Just select the rows to copy in any column and use the following. Note that if more than one row is selected the macro will use the user's selection to determine what to copy, otherwise it will copy visible rows from 2 to the end of the data.

Sub MyCOPY()
'
' COPY Macro
'
'
Dim LR As Long, LR2 As Long, i As Long
If Selection.Rows.Count > 1 Then
    i = Selection.Row
    LR = Selection.Row + Selection.Rows.Count - 1
Else
    i = 2
    LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
End If
LR2 = WorksheetFunction.Max(6, Workbooks("ToThis.xlsm").Sheets("TEST").Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row + 1)
Range("A" & i & ":A" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("E" & LR2)
Range("B" & i & ":B" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("D" & LR2)
Range("C" & i & ":C" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("C" & LR2)
Range("E" & i & ":E" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("A" & LR2)
Range("G" & i & ":G" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("F" & LR2)
Range("H" & i & ":H" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("ToThis.xlsm").Sheets("TEST").Range("G" & LR2)
Application.CutCopyMode = False
End Sub