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

Using Excel VBA to move columns for different workbooks

我的脚本将列从一个 sheet 移动到另一个,但我必须将工作簿的名称放入我希望它工作的 VBA 脚本中。我可能没有很好地解释它,但我会附上脚本。我如何将此代码用于不同的工作簿,而不仅仅是使用此处名称的代码 >Set objWorkbook = objExcel.Workbooks.Open("Referrals") 我必须输入其中的名称 excel 我正在使用的文件放入括号中以使宏工作

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

<

我不知道你想使用多少个工作簿,因为你没有提供完整的信息,所以我们猜测你想在每次使用它时自定义使用。

只需替换行

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

使用此代码:

' 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

每次执行此代码时,代码都会要求您提供工作簿。