使用 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
每次执行此代码时,代码都会要求您提供工作簿。
我的脚本将列从一个 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
每次执行此代码时,代码都会要求您提供工作簿。