将特定列从多个工作簿复制到一个主工作簿，而无需不断编辑代码

Question

我正在尝试从工作簿中读取一组特定的列（每周都是一个新的工作簿）并将它们复制到另一个工作簿中。我已经能够做到这一点，但我认为有一种更清洁的方法！我的代码非常笨重且有问题，因为每周我都需要从不同的工作簿中读取信息，所以我必须返回代码并更改工作簿文件名。我希望有关如何改进代码和加快更改工作簿的文件名的任何输入，从中复制列....例如，是否可以要求用户输入文件名来代替静态名称??

非常感谢任何反馈/建议！我的代码如下：

Sub CopyColumnToWorkbook()
Dim sourceColumns As Range, targetColumns As Range
Dim qw As Range, rw As Range
Dim sd As Range, fd As Range
Dim bu As Range, hu As Range
Dim zx As Range, gx As Range
Dim op As Range, wp As Range
Dim ty As Range, ly As Range


Set sourceColumns = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("L")
Set targetColumns = Workbooks("LU.xls").Worksheets(1).Columns("A")
Set qw = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("G")
Set rw = Workbooks("LU.xls").Worksheets(1).Columns("B")
Set sd = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("C")
Set fd = Workbooks("LU.xls").Worksheets(1).Columns("C")
Set bu = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("N")
Set hu = Workbooks("LU.xls").Worksheets(1).Columns("D")
Set zx = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("R")
Set gx = Workbooks("LU.xls").Worksheets(1).Columns("E")
Set op = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("S")
Set wp = Workbooks("LU.xls").Worksheets(1).Columns("F")
Set ty = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("I")
Set ly = Workbooks("LU.xls").Worksheets(1).Columns("G")


sourceColumns.Copy Destination:=targetColumns
qw.Copy Destination:=rw
sd.Copy Destination:=fd
bu.Copy Destination:=hu
zx.Copy Destination:=gx
op.Copy Destination:=wp
ty.Copy Destination:=ly
End Sub

Answer 1

整齐地接受用户输入的一种简单方法是使用InputBox函数

Sub ReadInputBox()

    Dim readWorkbookLocation As String
    readWorkbookLocation = InputBox("What is the name of the workbook you wish to read from?", "Workbook Select")

    MsgBox workbookFile

End Sub

Answer 2

烨。您可以使用Application.GetOpenFilename让用户选择文件名。例如

Option Explicit

Sub Sample()
    Dim Ret
    Dim Wb As Workbook
    Dim ws As Worksheet

    Ret = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")

    If Ret <> False Then
        Set Wb = Workbooks.Open(Ret)
        Set ws = Wb.Sheets("Sheet1")

        With ws
            '
            '~~> Do whatever you want to do here with the worksheet
            '
        End With
    End If
End Sub

编辑：我刚刚注意到您已将其标记为excel-vba-mac。如果您在Excel 2011上执行此操作，请参阅此link，其中显示了如何使用Application.GetOpenFilename。其余的代码保持不变。

Answer 3

对于这些类型的操作，我使用包含vb代码的单独Excel文件。 （我将此文件称为“操作”）。在工作表上放置源/目标文件的名称。添加“选择源”，“选择目标”等按钮，这将提示输入文件，但仅将选定的文件名放在工作表上。另一个按钮“Go”将使用指定的文件执行实际操作，如：

如果要复制的列很少更改，则可以将其保留在VBA中。如果它不时更改或您需要多个版本，请将其放在操作工作表上。如果您需要更复杂的方案，可以将配置放在源/目标工作簿中的另一个工作表上，以便作者可以自己指定列。

作为代码的建议，对文件名使用常量/变量，以便在手动更改文件名时最小化键入。同时为变量分配正在操作的工作簿和工作表。

' OPERATIONS SHEET
Dim operWB as Workbook
Dim operWS as Worksheet
Set operWB = Application.ActiveWorkbook
Set operWS = operWB.ActiveSheet

' SOURCE
Dim srcFN as string

' HARDCODED: same as before
'srcFN = "WERT_2013_01_24.xlsx"

' OR get from Cell C2
srcFN = operWS.Cell( 2, 3 )

Dim srcWB as Workbook
Dim srcWS as Worksheet
Set srcWB = Workbooks.Open( srcFN )
Set srcWS = srcWB.Worksheets( 0 )

' DESTINATION
.... do the same ...

.... OPTION 1: COPY ....
Set srcRange = srcWS.Columns( "L" ) ' <-- or get from B10
Set dstRange = dstWS.Columns( "A" ) ' <-- or get from C10
srcRange.Copy Destination:=dstRange
....

.... OPTION 2: COPY AS LOOP ....
Dim currentRow As Integer
currentRow = 10
' keep going while B10, B11... is not empty
While operWS.Cells(currentRow, 2) <> ""
    Set srcRange = srcWS.Columns( operWS.Cells(currentRow, 2) ) ' B10, B11 ...
    Set dstRange = dstWS.Columns( operWS.Cells(currentRow, 3) ) ' C10, C11 ...
    srcRange.Copy Destination:=dstRange
    currentRow = currentRow + 1
Wend

Answer 4

您可以使用以下简单代码循环浏览文件夹中的所有文件，而不知道其名称和数量：

LoopFileNameExt = Dir(InputFolder & "*.xls?")
Do While LoopFileNameExt <> ""
'your code here
LoopFileNameExt = Dir
Loop

文件掩码中允许使用通配符。祝你好运！