簡體   English   中英

將特定工作表中的數據提取到新工作簿

[英]Extracting data from a specifc worksheet to a new workbook

我目前在嘗試提取單元格數據並將它們粘貼到新工作簿中時遇到問題。 為了使事情更清楚,這里是步驟

  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

只需使用這樣的東西來填寫新工作簿中的值

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

檢查數組的大小與循環的長度 - 我認為“i”循環應該去

For i = 1 To last_col -1

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM