Question

我正在尝试使用宏将多个单元格从一个工作簿中的一个工作表复制到主工作表。我使用记录工具创建了一个宏，但是当我尝试在不同的工作簿中运行它时，代码的第一部分适用于不同的工作簿，但其他部分则返回原始工作表。我看到宏不断激活特定窗口（＆＃34; Vincent ......＆＃34;）我想知道如何将所选工作表定义为变量，从而使用该变量执行其余的激活？ / p>

Range("F4:F14").Select
Selection.Copy
Windows("Combined Spreadsheet.xlsx").Activate
Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
    , Transpose:=True
Windows("VincentCAIN107_Intra1_VD1_Rudd.xlsx").Activate
Range("H4:H14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Combined Spreadsheet.xlsx").Activate
Range("L" & Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
    , Transpose:=True
Windows("VincentCAIN107_Intra1_VD1_Rudd.xlsx").Activate
Range("N4:N14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Combined Spreadsheet.xlsx").Activate
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
    , Transpose:=True
Windows("VincentCAIN107_Intra1_VD1_Rudd.xlsx").Activate
Range("R4:R14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Combined Spreadsheet.xlsx").Activate
Range("AF" & Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
    , Transpose:=True
Windows("VincentCAIN107_Intra1_VD1_Rudd.xlsx").Activate
Range("S4:S14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Combined Spreadsheet.xlsx").Activate
Range("AP" & Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=True _
    , Transpose:=True

Answer 1

我认为你可以稍微清理你的代码。这是一个例子：

Sub JoinArray()
    Dim master As Worksheet, source As Worksheet, copyCols() As Variant, pasteCols() As Variant, i As Integer

    Set master = Workbooks("Combined Spreadsheet").Worksheets(1)
    Set source = Workbooks("VincentCAIN107_Intra1_VD1_Rudd").Worksheets(1)
    copyCols = Array("F", "H", "N", "R", "S")
    pasteCols = Array("B", "L", "V", "AF", "AP")

    For i = 0 To UBound(copyCols)
        source.Range(copyCols(i) & "4:" & copyCols(i) & 14).Copy
        master.Range(pasteCols(i) & master.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Next i
End Sub

注意：

预先设置对工作表的引用
如果您知道要复制和粘贴的列，则可以在数组中定义它们以供参考

Answer 2

在宏的顶部声明一个字符串

DIM BookName As String

然后为其分配书名

BookName = "VincentCAIN107_Intra1_VD1_Rudd.xlsx"

然后您可以将其与Windows方法

一起使用

Windows(BookName).Activate

为了简化代码，添加一个函数来处理给定正确参数的复制

Sub CopyCells(Book1 As String, Book2 As String, RngSrc As String, ColumnDest As String)
    Windows(Book1).Activate  
    Range(RngSrc).Select     
    Selection.Copy
    Windows(Book2).Activate
    Range(ColumnDest & Rows.Count).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial _
        Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub

使用此功能可将源代码缩减为

Sub CopyWorkbooks()
    Dim Book1 As String
    Dim Book2 As String

    Book1 = "VincentCAIN107_Intra1_VD1_Rudd.xlsx"
    Book2 = "Combined Spreadsheet.xlsx"

    Call CopyCells(Book1, Book2, "F4:F14", "B")
    Call CopyCells(Book1, Book2, "H4:H14", "L")
    Call CopyCells(Book1, Book2, "N4:N14", "V")
    Call CopyCells(Book1, Book2, "R4:R14", "AF")
    Call CopyCells(Book1, Book2, "S4:S14", "AP")
End Sub

Answer 3

将变量设置为工作簿:(示例）

Option Explicit  'this forces to declare variables (, always good)

Sub MySub
Dim Wb as Workbook , MainWB as workbook

Set MainWB = Workbooks("Combined Spreadsheet.xlsx")    'assuming it is opened

Err.clear
On Error resume Next 'if the workbook is not opened yet, it will throw an error
Set Wb= Workbooks ("WhateverName.xls") ' <<<<<<<<<<  this is the way of setting the workbook to read from
If err<>0 then 'can also be written: if Wb is nothing then
    Err.clear
    Set Wb= Workbooks.Open (Thisworkbook.path & "\" & "WhateverName.xls") 'If Wb not open yet, we do it now, assuming the file is in the same path as this main workbook
end if

On Error Goto 0 'reset error handling

'work with Wb :
With Wb
    .Sheets("AnySheetYouWant").Range("AnyRange").Copy  'by the way, no need to select or activate, "selection" can be replaced by a range
    MainWB.range("V" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlAll, Operation:=xlNone, _
             SkipBlanks:=False , Transpose:=True
    .Save  ' just for example
    .Close ' just for example
End With

Set Wb = Nothing ' i like freeing memory at the end of Subs...
Set MainWB= Noting
End Sub

Macro Recorder对初学者来说并不算太糟糕，但很快它的编程真的很糟糕...... 阅读内容，使用谷歌，提问......

我试图将多个工作簿中的值复制到一个工作表中

3 个答案: