Question

我要创建一个允许我从特定区域收集数据的宏，例如，A1-Ax和G1-Gx在一张纸上，而B1-Bx在另一张纸上等等，在许多不同的工作簿中加入一个主要的excel表。我喜欢5-6个Excel文件，我必须从中收集数据，它们都包含4-5个工作表。

通过以下代码，我可以收集所选Worksheet中每个Workbooks的所有数据。

但我必须收集的数据来自特定Range，因Worksheet和/或Workbook而异。

到目前为止我的代码看起来像这样：

Function LastUsedCell(wks As Excel.Worksheet) As Excel.Range
With wks
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        Set LastUsedCell = .Cells.Find(What:="*", _
            After:=.Range("A1"), _
            Lookat:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False)
    End If
End With
End Function

Function GetNextRowStart(wks As Excel.Worksheet) As Excel.Range
Dim lastCell As Excel.Range
Dim nextRow As Integer
nextRow = 1
Set lastCell = LastUsedCell(wks)
If Not lastCell Is Nothing Then nextRow = lastCell.Row + 1
Set GetNextRowStart = wks.Cells(nextRow, 1)
End Function

Sub Multi()
Dim outputWorkbook As Excel.Workbook
Dim outputWorksheet As Excel.Worksheet
Dim filepath As Variant

Set outputWorkbook = Workbooks.Open("C:\Users\z003k50s\Desktop\Test\Output.xlsx")
Set outputWorksheet = outputWorkbook.Sheets("Sheet1")

For Each filepath In Application.GetOpenFilename(FileFilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
    Dim wkbk As Excel.Workbook
    Dim wks As Excel.Worksheet
    Set wkbk = Workbooks.Open(filepath, , True)
    For Each wks In wkbk.Sheets
        Dim sourceRange As Excel.Range
        Dim outputRange As Excel.Range
        With wks
            Set sourceRange = .Range(.Cells(1, 1), LastUsedCell(wks))
        End With
        Set outputRange = GetNextRowStart(outputWorksheet)
        sourceRange.Copy outputRange
    Next
Next

outputWorksheet.Columns.AutoFit

End Sub

Answer 1

我知道这听起来像很多工作，但只需用复制和粘贴进行硬编码。这绝对不是最好的方法，但它会完成这项工作。

从选定工作簿中的多个工作表中的特定区域获取数据

1 个答案: