Vba 将数据从特定工作表提取到新工作簿

我目前在尝试提取单元格数据并将其粘贴到新工作簿时遇到问题。为了让事情更清楚，这里有一些步骤

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

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

创建新工作簿并将数据粘贴到其中（每个工作簿将在工作表中指定一行，提取的所有数据将在同一工作表中）

我的上一个sub提取此单元格数据并将其粘贴到新工作簿中时遇到问题，以下是我目前的情况：

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

子周期_wb（）
将ws设置为工作表
将wb设置为工作簿
将书籍作为工作簿
暗计数器长度，最后一行长度，最后一列长度
尺寸i，j，k为整数
Dim data（）作为字符串
计数器=1
开/关
查询\u电视\u值
对于工作簿中的每个wb
如果wb.Name ThisWorkbook.Name，则
MsgBox“正在处理”和wb.Name
PerLineItem2 wb
阈值\u值\u全额支付wb
如果结束
下一个
“这只是我对以下部分有意见的部分：(
设置工作簿=工作簿。添加
Set ws=book.Sheets.Add（book.Sheets（1））
ws.Name=“最终报告”
对于工作簿中的每个wb
如果是（wb.Name ThisWorkbook.Name或wb.Name book.Name），则
摘录\报告\最终wb、计数器、书籍
计数器=计数器+1
下一个wb
端接头

只需使用类似的方法填写新工作簿中的值即可

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

检查数组的大小和循环的长度-我认为“I”-循环应该继续

For i = 1 To last_col -1

---

投票结束您的问题。因为我被要求审查投票，我知道这是因为投票人发现您的问题不清楚。我同意，但我认为投票结束前应先发表评论，解释投票原因。研究了您的代码一段时间后，我提出以下建议。（1）就访问权限而言，新工作簿与旧工作簿没有什么不同。唯一的区别是您必须在退出之前使用SaveAs将其写入光盘。（2）您的wb.Sheets（“报告”）中有

，但我找不到匹配的
以
结尾。（3）您有
.book.ws
但
book
不在
wb.Sheets中(“Report”）
因此删除前导句点，我找不到您在哪里初始化
ws
。