VBA Macro - send specific columns from one workbook to another

[atditiljazi]

hi all,

I'm after a macro that will copy and paste specific columns from 1 work book to another. what i would like the macro to do is the following,

copy columns C,H,D,E,J,l,M,K,W,P,X,Y from one workbook (sheet1) and paste them to another workbook (sheet name: order book) in A,B,C,D,E,F,G,H,I,J,K,L. i will have the header in row 1 so the information will need to be taken from row 2 and work its way down until it reaches the last row.

please see attached image, I hope that makes it more clearer.

any help will be really appreciated.

.

 

[breynolds0431]

Would this work for you?

Option Explicit

Sub copycolumns()

'workbook and sheet declarations
Dim tWB As Workbook: Set tWB = ThisWorkbook
Dim tWS As Worksheet: Set tWS = tWB.Sheets("Sheet1")
Dim xWB As Workbook: Set xWB = Workbooks("Set WB Name Here.xlsx")
Dim xWS As Worksheet: Set xWS = xWB.Sheets("order book")

'last row declarations
Dim tLRow As Long: tLRow = tWS.Cells(tWS.Cells.Rows.Count, 1).End(xlUp).Row
Dim xLRow As Long: xLRow = xWS.Cells(xWS.Cells.Rows.Count, 1).End(xlUp).Row

'copy columns C,H,D,E,J,I,M,K,W,P,X,Y from tWS to columns A:L in xWS
With tWS
    .Range("C2:C" & tLRow).Copy xWS.Cells(xLRow + 1, 1)
    .Range("H2:H" & tLRow).Copy xWS.Cells(xLRow + 1, 2)
    .Range("D2:D" & tLRow).Copy xWS.Cells(xLRow + 1, 3)
    .Range("E2:E" & tLRow).Copy xWS.Cells(xLRow + 1, 4)
    .Range("J2:J" & tLRow).Copy xWS.Cells(xLRow + 1, 5)
    .Range("I2:I" & tLRow).Copy xWS.Cells(xLRow + 1, 6)
    .Range("M2:M" & tLRow).Copy xWS.Cells(xLRow + 1, 7)
    .Range("K2:K" & tLRow).Copy xWS.Cells(xLRow + 1, 8)
    .Range("W2:W" & tLRow).Copy xWS.Cells(xLRow + 1, 9)
    .Range("P2:P" & tLRow).Copy xWS.Cells(xLRow + 1, 10)
    .Range("X2:X" & tLRow).Copy xWS.Cells(xLRow + 1, 11)
    .Range("Y2:Y" & tLRow).Copy xWS.Cells(xLRow + 1, 12)
End With

End Sub

 

[Peter_SSs]

If it is just the cell values that you are interested in (that is, not formulas, formatting etc) then you could consider this approach that transfers all the columns/values at once.

There are some other things that are not quite clear but this is what I have used/assumed

• The source data is in a workbook called atditiljazi1.xlsm though the name is not important. The code is housed in this workbook though.
• The target workbook is called atditiljazi2.xlsm. Edit the code to suit.
• I have assumed that sheet 'order book' in that target workbook is currently blank. Modification required if that is not the case. Would ned more details.
• I have assumed that both workbooks are open when the code is run.

Sub Copy_Values()
  Dim ws1 As Worksheet, ws2 As Worksheet
  Dim aRws As Variant, aCols As Variant
  Dim lr As Long
 
  Const ColsOfInterest As String = "3 8 4 5 10 9 13 11 23 16 24 25"   'Cols C,H,D,E,J,l,M,K,W,P,X,Y
 
  Set ws1 = ThisWorkbook.Sheets("Sheet1")
  Set ws2 = Workbooks("atditiljazi2.xlsm").Sheets("order book")
  lr = ws1.Columns("A:Y").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  aRws = Evaluate("row(1:" & lr & ")")
  aCols = Split(ColsOfInterest)
  ws2.Range("A1").Resize(lr, UBound(aCols) + 1).Value = Application.Index(ws1.Cells, aRws, aCols)
End Sub

 

[atditiljazi]

If it is just the cell values that you are interested in (that is, not formulas, formatting etc) then you could consider this approach that transfers all the columns/values at once.

There are some other things that are not quite clear but this is what I have used/assumed

• The source data is in a workbook called atditiljazi1.xlsm though the name is not important. The code is housed in this workbook though.
• The target workbook is called atditiljazi2.xlsm. Edit the code to suit.
• I have assumed that sheet 'order book' in that target workbook is currently blank. Modification required if that is not the case. Would ned more details.
• I have assumed that both workbooks are open when the code is run.

Sub Copy_Values()
  Dim ws1 As Worksheet, ws2 As Worksheet
  Dim aRws As Variant, aCols As Variant
  Dim lr As Long
 
  Const ColsOfInterest As String = "3 8 4 5 10 9 13 11 23 16 24 25"   'Cols C,H,D,E,J,l,M,K,W,P,X,Y
 
  Set ws1 = ThisWorkbook.Sheets("Sheet1")
  Set ws2 = Workbooks("atditiljazi2.xlsm").Sheets("order book")
  lr = ws1.Columns("A:Y").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  aRws = Evaluate("row(1:" & lr & ")")
  aCols = Split(ColsOfInterest)
  ws2.Range("A1").Resize(lr, UBound(aCols) + 1).Value = Application.Index(ws1.Cells, aRws, aCols)
End Sub

hi Peter,

thank you for taking your time to help me.


i have tried your code but it does not work how i would want it to. i will go in to more detail, I have 2 workbooks, 1 is the main workbook (order book) that will need to be sent out to our suppliers, and the other workbook (data) is where people store the data in so it can be sent to the master workbook at the end of the week.

i would ideally like to keep the main workbook closed when I transfer the data from the data workbook. I would not like the macro to copy anything from row 1 due to the headers being different in both workbooks.

the macro will need to transfer data in columns, C,H,D,E,J,l,M,K,W,P,X,Y (starting from row 2) and put them in the main workbook in columns, A,B,C,D,E,F,G,H,I,J,K,L (starting in row 2). i hope that gives you more of a clearer picture. i will upload 2 excel spreadsheets on my main post as an example

 

[atditiljazi]

Would this work for you?

Option Explicit

Sub copycolumns()

'workbook and sheet declarations
Dim tWB As Workbook: Set tWB = ThisWorkbook
Dim tWS As Worksheet: Set tWS = tWB.Sheets("Sheet1")
Dim xWB As Workbook: Set xWB = Workbooks("Set WB Name Here.xlsx")
Dim xWS As Worksheet: Set xWS = xWB.Sheets("order book")

'last row declarations
Dim tLRow As Long: tLRow = tWS.Cells(tWS.Cells.Rows.Count, 1).End(xlUp).Row
Dim xLRow As Long: xLRow = xWS.Cells(xWS.Cells.Rows.Count, 1).End(xlUp).Row

'copy columns C,H,D,E,J,I,M,K,W,P,X,Y from tWS to columns A:L in xWS
With tWS
    .Range("C2:C" & tLRow).Copy xWS.Cells(xLRow + 1, 1)
    .Range("H2:H" & tLRow).Copy xWS.Cells(xLRow + 1, 2)
    .Range("D2:D" & tLRow).Copy xWS.Cells(xLRow + 1, 3)
    .Range("E2:E" & tLRow).Copy xWS.Cells(xLRow + 1, 4)
    .Range("J2:J" & tLRow).Copy xWS.Cells(xLRow + 1, 5)
    .Range("I2:I" & tLRow).Copy xWS.Cells(xLRow + 1, 6)
    .Range("M2:M" & tLRow).Copy xWS.Cells(xLRow + 1, 7)
    .Range("K2:K" & tLRow).Copy xWS.Cells(xLRow + 1, 8)
    .Range("W2:W" & tLRow).Copy xWS.Cells(xLRow + 1, 9)
    .Range("P2:P" & tLRow).Copy xWS.Cells(xLRow + 1, 10)
    .Range("X2:X" & tLRow).Copy xWS.Cells(xLRow + 1, 11)
    .Range("Y2:Y" & tLRow).Copy xWS.Cells(xLRow + 1, 12)
End With

End Sub

hi Brenolds. thank you for taking the time to help.

your macro works how i would want it to is it possible to tweak it so i don't have to have xWB work book open for the macro to work? is it possible to put the file location in the macro?

thank you in advance.

 

[Peter_SSs]

I would not like the macro to copy anything from row 1 due to the headers being different in both workbooks.

the macro will need to transfer data in columns, C,H,D,E,J,l,M,K,W,P,X,Y (starting from row 2) and put them in the main workbook in columns, A,B,C,D,E,F,G,H,I,J,K,L (starting in row 2). i

For that, try ..

Sub Copy_Values_v2()
  Dim ws1 As Worksheet, ws2 As Worksheet
  Dim aRws As Variant, aCols As Variant
  Dim lr As Long

  Const ColsOfInterest As String = "3 8 4 5 10 9 13 11 23 16 24 25"   'Cols C,H,D,E,J,l,M,K,W,P,X,Y

  Set ws1 = ThisWorkbook.Sheets("Sheet1")
  Set ws2 = Workbooks("atditiljazi2.xlsm").Sheets("order book")
  lr = ws1.Columns("A:Y").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  aRws = Evaluate("row(2:" & lr & ")")
  aCols = Split(ColsOfInterest)
  ws2.Range("A2").Resize(lr - 1, UBound(aCols) + 1).Value = Application.Index(ws1.Cells, aRws, aCols)
End Sub

i would ideally like to keep the main workbook closed when I transfer the data from the data workbook.

I am unable to help with that.