使用Excel VBA移动不同工作簿的列

Question

The script that I have moves columns from one sheet to another, but I have to put the name of the work book into the VBA script that I want it to work for. I may not be explaining it well, but I will attache the script. How do I use this code for different work books and not just one with the name that is here >Set objWorkbook = objExcel.Workbooks.Open("Referrals") I have to put the name of the which ever excel file I am using into the parenthesis for the macro to work

Sub Column_Test()
'
' Column_Test Macro
'
' Keyboard Shortcut: Ctrl+c
Set objExcel = CreateObject("Excel.Application") 'Moves cell A1 to A1'    
objExcel.Visible = True    
Set objWorkbook = objExcel.Workbooks.Open("Referrals") 
' "Refferals" is the name of the excel workbook '

Set objWorksheet = objWorkbook.Worksheets(1)    
objWorksheet.Activate   

Set objRange = objWorksheet.Range("A1").EntireColumn

objRange.Copy      
Set objWorksheet = objWorkbook.Worksheets(2)    
objWorksheet.Activate        
Set objRange = objWorksheet.Range("A1")    
objWorksheet.Paste (objRange)    ''



Set objWorksheet = objWorkbook.Worksheets(1) 'Moves cell E1 to B1'

objWorksheet.Activate


Set objRange = objWorksheet.Range("E1").EntireColumn

objRange.Copy


Set objWorksheet = objWorkbook.Worksheets(2)

objWorksheet.Activate


Set objRange = objWorksheet.Range("B1")

objWorksheet.Paste (objRange)

''


'Moves Cell F1 to C1'

Set objWorksheet = objWorkbook.Worksheets(1)

objWorksheet.Activate

Set objRange = objWorksheet.Range("F1").EntireColumn

objRange.Copy


Set objWorksheet = objWorkbook.Worksheets(2)

objWorksheet.Activate


Set objRange = objWorksheet.Range("C1")
objWorksheet.Paste (objRange)

Set objWorksheet = objWorkbook.Worksheets(1)

objWorksheet.Activate
''



Set objRange = objWorksheet.Range("G1").EntireColumn

objRange.Copy


Set objWorksheet = objWorkbook.Worksheets(2)

objWorksheet.Activate


Set objRange = objWorksheet.Range("D1")

objWorksheet.Paste (objRange)

Set objWorksheet = objWorkbook.Worksheets(1)

objWorksheet.Activate
''



Set objRange = objWorksheet.Range("H1").EntireColumn

objRange.Copy


Set objWorksheet = objWorkbook.Worksheets(2)

objWorksheet.Activate


Set objRange = objWorksheet.Range("E1")

objWorksheet.Paste (objRange)


Set objWorksheet = objWorkbook.Worksheets(1)

objWorksheet.Activate
''



Set objRange = objWorksheet.Range("K1").EntireColumn

objRange.Copy


Set objWorksheet = objWorkbook.Worksheets(2)

objWorksheet.Activate


Set objRange = objWorksheet.Range("F1")

objWorksheet.Paste (objRange)

Set objWorksheet = objWorkbook.Worksheets(1)

objWorksheet.Activate
''



Set objRange = objWorksheet.Range("M1").EntireColumn

objRange.Copy


Set objWorksheet = objWorkbook.Worksheets(2)

objWorksheet.Activate


Set objRange = objWorksheet.Range("G1")

objWorksheet.Paste (objRange)



'
End Sub

<

Answer 1

I don't know how many workbooks you want to use this because you do not provide full information, so let's guess you want to custom the use every time you use it.

Just replace the line

Set objWorkbook = objExcel.Workbooks.Open("Referrals")

With this code:

' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = False
    .Filters.Add "Excel Files", "*.xlsx", 1

    If .Show = 0 Then Exit Sub
    ' Display paths of each file selected
    Set objWorkbook = Application.Workbooks.Open(.SelectedItems(1))
End With

The code will ask you for a workbook every time you execute this code.