将特定工作表中的数据提取到新工作簿

Question

我目前在尝试提取单元格数据并将它们粘贴到新工作簿中时遇到问题。 为了使事情更清楚，这里是步骤

1. 访问所有打开的工作簿（运行宏的工作簿除外）中的特定工作表（“报告”）

2. 从工作表中，提取某些单元格数据（行数和列数不固定，但在打开的工作簿中它们是相同的）

3. 创建一个新的工作簿并将数据粘贴到那里（每个工作簿将在工作表中分配一行，提取的所有数据将在同一张工作表上）

我的最后一个子程序遇到了问题，该子程序提取此单元格数据并将其粘贴到新工作簿中，这是我目前所拥有的：

Function Extract_Report_Final(wb As Workbook, book As workbook, counter as long)

Dim last_row, last_col As Long
Dim ws As Worksheet
Dim i, j, k As Integer
Dim data() As String

With wb.Sheets("Report") 'for each worksheet in each open workbook

    last_row = .Range("C" & .Rows.Count).End(xlUp).Row
    last_col = .Cells(last_row, .Columns.Count).End(xlToLeft).Column
    'to get the last row and column where the data required will be located
    'this is identical throughout the workbooks as is the name of the worksheet

    ReDim data(last_col - 1)
    'I decided to use an array to store the values as i don't know how else :(

    For k = 0 To (last_col - 2)
        Select Case k

            Case 0: data(k) = .Cells(1, 1).Value
            Case 1: data(k) = .Cells(last_row, 3).Value
            Case Else: data(k) = .Cells(last_row, k + 2).Value
        End Select
    Next k

    k = 0
    'A weak attempt at trying to copy.paste the values onto a new workbook
    'I also don't know how to reference a newly created workbook :(

    For i = 1 To last_col
    '"book" is the variable workbook which will house the extracted data
    .book.ws.Cells(counter, i) = data(k)
    k = k + 1
    Next i

End Function

以下是我的主要子项：

Sub Cycle_wb()

Dim ws As Worksheet
Dim wb As Workbook
Dim book As Workbook
Dim counter As Long, last_row As Long, last_col As Long
Dim i, j, k As Integer
Dim data() As String

counter = 1

open_close

Query_Tv_values

For Each wb In Workbooks
    If wb.Name <> ThisWorkbook.Name Then
        MsgBox "working on " & wb.Name
        PerLineItem2 wb
        Threshold_Value_PayFull wb
    End If
Next
'It's just the part below which I'm having issues with :(

Set book = Workbooks.Add
Set ws = book.Sheets.Add(book.Sheets(1))
ws.Name = "Report_Final"

For Each wb In Workbooks
    If (wb.Name <> ThisWorkbook.Name Or wb.Name <> book.Name) Then
        Extract_Report_Final wb, counter, book
        counter = counter + 1
Next wb

End Sub

Answer 1

只需使用这样的东西来填写新工作簿中的值

    Cells(counter, i).Value = data(i-1)

检查数组的大小与循环的长度 - 我认为“i”循环应该去

For i = 1 To last_col -1