我需要编写一个宏脚本,它将从一个xml工作簿中复制数据并将值粘贴到另一个工作簿。我写了下面的宏工作正常,但我需要每周运行几个不同的文档,所以这意味着我必须替换每次运行的文档名称。
这是我到目前为止所拥有的:
Sub copying()
''''''Section 1''''''
Workbooks("Results_2561").Activate 'workbook i'm copying from
Range("B27:B41").Select
Selection.Copy
Workbooks("Overall_Results").Activate 'workbook i'm pasting to
Range("G2").PasteSpecial
''''''Section 2''''''
Workbooks("Results_2561").Activate
Range("C27:C41").Select
Selection.Copy
Workbooks("Overall_Results").Activate
Range("C2").PasteSpecial
''''''Section 3''''''
Workbooks("Results_2561").Activate
Range("I28:I40").Select
Selection.Copy
Workbooks("Overall_Results").Activate
Range("G17").PasteSpecial
''''''Section 4''''''
Workbooks("Results_2561").Activate
Range("J28:J40").Select
Selection.Copy
Workbooks("Overall_Results").Activate
Range("C17").PasteSpecial
End Sub
... 这只是剧本的一半。有没有办法我可以在开始时声明一个变量并将其设置为工作簿文件路径,这样我可以调用它而不是一次又一次地键入和重新输入? 最好不要使用像
这样的东西Dim book1 as Workbook
Set book1 = Workbooks.Open("C://Results_2561.xlsm")
..因为这会在我运行脚本时保持打开和关闭文档。
由于
答案 0 :(得分:0)
因为您只对复制值感兴趣,所以可以使用此助手Sub
Sub CopyValues(rngToCopyFrom As Range, rngToCopyTo As Range)
With rngToCopyFrom
rngToCopyTo.Resize(.Rows.COUNT, .Columns.COUNT).Value = .Value
End With
End Sub
将在您的主要代码中被利用,如下所示:
Sub main()
Dim wsTo As Worksheet
Set wsTo = Workbooks("Overall_Results").ActiveSheet '<--| set the worksheet to paste values to
With Workbooks("Results_2561").ActiveSheet '<--| reference the worksheet to copy values from
CopyValues .Range("B27:B41"), wsTo.Range("G2")
CopyValues .Range("C27:C41"), wsTo.Range("C2")
CopyValues .Range("I28:I40"), wsTo.Range("G17")
CopyValues .Range("J28:J40"), wsTo.Range("C17")
End With
End Sub
如果您的相关工作簿有多个工作表,那么只需替换
ActiveSheet
与
Worksheets("myRelevantShetName") '<--|change "myRelevantShetName" to the actual name of the relevant worksheet in each workbook
答案 1 :(得分:0)
首先,每次要复制/粘贴某些内容时,都不必激活工作簿。只需在Range()
属性中声明它,例如:
''''''Section 1''''''
Workbooks("Results_2561").Sheets(1).Range("B27:B41").Copy
Workbooks("Overall_Results").Sheets(1).Range("G2").PasteSpecial
您可以将Workbook设置为变量,如:
Sub copying()
Dim wb1 As Workbook, wb2 As Workbook
Set wb1 = Workbooks("Results_2561")
Set wb2 = Workbooks("Overall_Results")
''''''Section 1''''''
wb1.Sheets(1).Range("B27:B41").Copy
wb2.Sheets(1).Range("G2").PasteSpecial
End Sub
最后,正如@ A.S.H建议的那样,您可以添加一个文件对话框,指向您要使用的文件。我已将它放在某个函数中(不要忘记将它放在与copying
宏相同的项目中):
Function strPath() As String
Dim intResult As Integer
Application.FileDialog(msoFileDialogFilePicker).Title = "Select file"
intResult = Application.FileDialog(msoFileDialogFilePicker).Show
If intResult <> 0 Then
strPath = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
End If
End Function
所以第1部分的最终代码如下:
Sub copying()
Dim wb1 As Workbook, wb2 As Workbook
MsgBox "Show file to copy form."
Set wb1 = Workbooks.Open(strPath())
MsgBox "Show file to paste in."
Set wb2 = Workbooks.Open(strPath())
''''''Section 1''''''
wb1.Sheets(1).Range("B27:B41").Copy
wb2.Sheets(1).Range("G2").PasteSpecial
End Sub