Question

我有一张有两张纸的工作簿：

'数据处理'包含单元格引用列表，如下所示：

Input Column    Input Row Start Input Row End       Output Column
C               88              105                 A
H               198             215                 B
G               253             270                 C

'结果'包含一个空表，第1行包含标题。

我想要一个VBA宏，它打开当前文件夹中的每个.xls文件，并根据数据表将数据从第一张表中的数据复制到“结果”表中。

例如，应打开第一个工作簿，并将C88：C105中保存的数据复制到“结果”的A列，然后是H198：H215到B行，接着是G253：G270到C列。

对于文件夹中的每个工作簿，应该重复此操作，数据将插入到“结果”表中的第一个空行（可以作为A列中的第一个空白单元格）中。

这就是我所拥有的：

Sub Consolidate()

Dim wkbkorigin As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim ResultRow As Long
Dim Fname As String


Set destsheet = Workbooks("Consolidate_data.xlsm").Worksheets("Results")

'get list of all files in folder
Fname = Dir(ThisWorkbook.Path & "/*.xls")

'loop through each file in folder (excluding this one)
Do While Fname <> "" And Fname <> ThisWorkbook.Name
    Set wkbkorigin = Workbooks.Open(ThisWorkbook.Path & "/" & Fname)
    Set originsheet = wkbkorigin.Worksheets("Sheet1")

    'find first empty row in destination table
    ResultRow = destsheet.Range("A1").End(xlDown).Offset(1, 0).Row 

    'start at top of list of cell references and work down until empty cell reached
    Application.Goto ThisWorkbook.Worksheets("Data Processing").Range("A2")

    Do While IsEmpty(ActiveCell) = False
        originsheet.Range(ActiveCell.Value & ActiveCell.Offset(0, 1).Value & ":" & ActiveCell.Value & ActiveCell.Offset(0, 2).Value).Copy
        destsheet.Range(ActiveCell.Offset(0, 4).Value & ResultRow & ":" & ActiveCell.Offset(0, 4).Value & (ResultRow + (ActiveCell.Offset(0, 2).Value - ActiveCell.Offset(0, 1).Value))).PasteSpecial
        ActiveCell.Offset(1, 0).Select
    Loop
    Workbooks(Fname).Close SaveChanges:=False   'close current file
    Fname = Dir     'get next file
Loop
End Sub

目前，宏停在ResultRow = destsheet.Range("A1").End(xlDown).Offset(1, 0) '.End(xlDown).Offset(1, 0).Row，运行时错误1004：应用程序错误或对象定义错误。

有什么想法吗？

Answer 1

我认为你真正的问题是你试图在一个声明中做太多。这意味着您和其他任何人都无法查看您的代码并查看它正在尝试执行的操作。您的代码越复杂，您需要的时间越长，在六个月后必须更新时，您需要花费的时间越长。下面的代码可能需要稍微长一点才能运行，但它易于理解且易于更新。

这段代码并不是我想要做的，但我试图遵循你的风格。

替换：

ResultRow = destsheet.Range("A1").End(xlDown).Offset(1, 0).Row

由：

ResultRow = destsheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

添加以下变量

Dim ColDest As String
Dim ColSrc As String
Dim RngDest As String
Dim RngSrc As String
Dim RowInstructCrnt As Long
Dim RowSrcEnd As Long
Dim RowSrcStart As Long

将Do循环替换为：

RowInstructCrnt = 2
With ThisWorkbook.Worksheets("Data Processing")
  Do While Not IsEmpty(.Cells(RowInstructCrnt, "A"))
    ColSrc = .Cells(RowInstructCrnt, "A")
    RowSrcStart = .Cells(RowInstructCrnt, "B")
    RowSrcEnd = .Cells(RowInstructCrnt, "C")
    ColDest = .Cells(RowInstructCrnt, "D")
    RngSrc = ColSrc & RowSrcStart & ":" & ColSrc & RowSrcEnd
    RngDest = ColDest & ResultRow
    originsheet.Range(RngSrc).Copy
    destsheet.Range(RngDest).PasteSpecial
    RowInstructCrnt = RowInstructCrnt + 1
 Loop
End With

注意：不仅上述代码的每个语句都是一步，它不会将光标移动到工作表“数据处理”周围。

将数据从多个工作簿复制到另一个工作簿

1 个答案: