Question

我正在尝试为宏创建脚本，该宏将复制excel中大型数据集中的某些列，并按相应的顺序创建这些列的新excel工作簿 - 只复制要复制的值而不是公式。这是我使用宏录制器后到目前为止所拥有的：

Sub Compfinder()
'
' Compfinder Macro
'

'
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
Columns("Q:Q").Select
Selection.Copy
Workbooks.Add
Columns("A:A").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Geo Location"
Windows("CompFinder Tool_Protected_final_11.25.13.xlsm").Activate
Columns("K:K").Select
Selection.Copy
Windows("Book1").Activate
Columns("B:B").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
    , SkipBlanks:=False, transpose:=False
Windows("CompFinder Tool_Protected_final_11.25.13.xlsm").Activate
Windows("Book1").Activate
Windows("CompFinder Tool_Protected_final_11.25.13.xlsm").Activate
Columns("L:L").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Book1").Activate
Columns("C:C").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
    , SkipBlanks:=False, transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
    "C:\Users\raysharm\Documents\Compfinder columns.csv", FileFormat:=xlCSV, _
    CreateBackup:=False
End Sub

运行宏时，我最终得到Windows("Book1").Activate的错误错误，我想我会在代码中进行其他剪切和粘贴。

有没有办法让每次运行宏时都会创建一个全新的工作簿，并且要复制和粘贴各自所需的列？我该怎么做而不是“Book1”？

谢谢，射线

Answer 1

激活＆amp;选择是代码中的常见问题。以下是如何避免使用它们的很好的参考。

下面是一个如何添加新工作簿并将其设置为变量的示例，以便您稍后可以在代码中轻松获得对它的引用：

Sub CreateWBandCopy()
    ' Link variable to source workbook
    Dim wbSource As Workbook
    Set wbSource = Workbooks("book1")

    ' Copy Column L from source book
    wbSource.Sheets(1).Range("L:L").Copy

    ' Create new workbook and assign to variable
    Dim wb As Workbook
    Set wb = Workbooks.Add

    ' Link sheet1 to variable  -can also use name like this: Sheets("Sheet1")
    Dim ws As Worksheet
    Set ws = wb.Sheets(1)

    ' Link Specific range to variable
    Dim rng As Range
    Set rng = ws.Columns("A:A")

    ' Paste source col L to new book col A
    rng.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

请注意，代码很容易跟踪正在执行的操作。您无需跟踪当前活动的书籍或工作表或单元格。

我不完全确定您的代码的逻辑，但这是我最好的猜测如何纠正您的引用。请注意，我使用了几种不同的技术来引用＆amp;设定范围。我并没有试图混淆代码，而是展示了做同样事情的不同方法。

另外，我使用了一些活动语句，因为我不确定你的源书名是什么。

Sub Compfinder()
'
' Compfinder Macro
'
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10

    Dim wbSource As Workbook
    Set wbSource = ActiveWorkbook

    Dim wsSource As Worksheet
    Set wsSource = wbSource.ActiveSheet

    Dim rngQ As Range
    Set rngQ = wsSource.Columns("Q:Q")

    rngQ.Copy

    '''''''''''''''''''''''''

    Dim wbNew As Workbook
    Set wbNew = Workbooks.Add

    Dim wsNew As Worksheet
    Set wsNew = wbNew.Sheets(1)

    Dim rng As Range
    Set rng = wsNew.Columns("A:A")

    rng.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    '''''''''''''''''''''''''

    Application.CutCopyMode = False

    wsNew.Range("A1").FormulaR1C1 = "Geo Location"

    wsSource.Columns("K:K").Copy

    wsNew.Columns("B:B").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    wsSource.Columns("L:L").Copy

    wsNew.Columns("C:C").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    wbNew.Activate
    ActiveWorkbook.SaveAs Filename:="C:\Users\raysharm\Documents\Compfinder columns.csv", FileFormat:=xlCSV, CreateBackup:=False
End Sub

除了上次保存（到你的路径）之外，我测试了代码运行没有错误。

创建VBA宏，从另一个Excel数据集的列创建新的合并工作簿

1 个答案: