Question

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

访问所有打开的工作簿中的特定工作表（“报表”）（运行宏的工作表除外）
从工作表中提取某些单元格数据（行和列的数量不是固定的，但在整个打开的工作簿中它们是相同的）
创建一个新工作簿并将数据粘贴到那里（每个工作簿将在工作表中分配一行，并且所有提取的数据将在同一工作表中）

我的最后一个子提取这个单元格数据并将其粘贴到一个新的工作簿中有问题，这是我到目前为止所做的：

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”-loop应该去

For i = 1 To last_col -1

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

1 个答案: