Search code examples
excelcopy-pastevba

Copy Three Columns from one workbook into another when all three ranges are different than the original ranges using Command Button


I am attempting to copy three ranges, Column A, B and C in Workbook 1 to columns B, C, and G in Workbook 2 using a command button and without having to have the destination workbook open. Here, Column A from WB1 goes to column B WB2, Column B from WB1 goes to column C WB2, and Column C from WB1 goes to column G WB2.

I've been able to copy and paste A and B into B and C using the following Code, but cannot figure out how to get C into G without using a different Command Button. I need the button to completely update the columns in the destination worksheet when it is clicked. This is how I went about the first two columns :

Private Sub CommandButton1_Click()
    ActiveSheet.Range("A2:B250").Copy
    Workbooks.Open Filename:="C:\Users\og677\Desktop\N
\Matlab\VehicleList1.xlsx"
    ActiveSheet.Cells(2, 2).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, skipblanks:=False, Transpose:=False
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Application.CutCopyMode = False
    
End Sub

I thought I might need to set the ranges so I was trying something like this, but I didn't know how and was getting in error where I attempt to set wb2.

Private Sub CommandButton1_Click()
    
    Dim O As Workbook
    
    Dim wb2 As Workbook
    
    Dim ESN As Worksheet
    Dim List As Worksheet
    
    Dim I As Integer
    Dim n As Integer
    
    
    Set O = ThisWorkbook
    Set wb2 = Workbooks("C:\Users.xlsx")
    
    Set ESN = O.Sheets("ESN Regression")
    Set List = VehicleList.Sheets("Sheet1")
     
    
    n = 2
    
    For I = 2 To WorksheetFunction.CountA(O.Columns.EntireColumn(1))
    
       
        If Cells(I, "I").Value = "Yes" Then
    
            List.Cells(n, "B").Value = ESN.Cells(I, "A")
            List.Cells(n, "C").Value = ESN.Cells(I, "B")
            List.Cells(n, "G").Value = ESN.Cells(I, "C")
            
           
            n = n + 1
    
        End If
    
    Next
    
End Sub

I'd like to be able to keep my first attempt if it could be done but I'm open to any changes at all.


Solution

  • Here's what I came up with:

        Private Sub CommandButton1_Click()
    ActiveSheet.Range("A2:B250").Copy
    Workbooks.Open Filename:="C:\Users\og677\Desktop\N\Matlab\VehicleList.xlsx"
    ActiveSheet.Cells(2, 2).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, skipblanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    ThisWorkbook.Activate
    ActiveSheet.Range("C2:C250").Copy
    Windows("VehicleList.xlsx").Activate
    ActiveSheet.Cells(2, 7).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, skipblanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    ActiveWorkbook.Save
    
    End Sub