I'm currently having problems trying to extract cell data and pasting them into a new workbook. To make things clearer here are the steps
Access a specific worksheet ("Report") in all open workbooks (except the one running the macro)
From the worksheet, extract certain cell data (no. of rows and columns are not fixed but they are identical throughout the open workbooks)
Create a new workbook and paste the data there (each workbook will be assigned one row in the sheet, and all data extracted will be on the same sheet)
I'm having problems with my last sub that extracts this cell data and pastes it into a new workbook, here's what I have so far:
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
Below is my main sub:
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
Just use something like this to fill out the values in your new workbook
Cells(counter, i).Value = data(i-1)
Check the size of you array vs the length of your loops though - I think the "i"-loop should go
For i = 1 To last_col -1
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.