简体   繁体   中英

VBA Can I create an Iterable object made of a selection of WorkSheets?

Im trying to automate a data management, I want to be able to select a variable number of sheets on an excel workbook, starting from a known sheet number, then loop into each sheet to select the data an then copy it into another sheet in the workbook so I can have a consolidate of all the data sheets and create a pivot table from it. For example the Sheets would look like this: PivotTable,ConsolidatedData,Sheet1,Sheet2,Sheet3,....SheetN

So I want to take the data from each Sheet into the Consolidated data sheet. What Im trying to do is to create an iterable dynamic object made of selected sheets so then I can iterate over every sheet and copy its data.

Can this be done in VBA?

This is what i have tried:

'Selecting worksheets'
    Dim x As Integer
    ThisWorkbook.Worksheets(7).Select
        For x = 8 To ThisWorkbook.Worksheets.Count
            Worksheets(x).Select (False)
        Next x

Dim MyArray As Variant
MyArray = Array(ActiveWindow.SelectedSheets)
        
'Loopin through selection of worksheets'
    Dim ws As Worksheet
        For Each ws In MyArray
            ws.Activate
            'Copy/paste of data'
                Range("U9").Select
                Range(Selection, Selection.End(xlToLeft)).Select
                Range(Selection, Selection.End(xlDown)).Select
                Selection.Copy
                Worksheets("ConsolidatedData").Activate
                Range("B1").Select
                Selection.End(xlDown).Select
                ActiveCell.Offset(1).Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
        Next ws

I´ve tried doing it without using the "MyArray" object and using ActiveWindow.SelectedSheets but this does not allows me to go back and forth from the ConsolidatedData to the Sheets that have the data. What I want to do is possible or should I do it differently?

My main doubt is if this is even possible in some way:

Dim MyArray As Variant
MyArray = Array(ActiveWindow.SelectedSheets)

Here's my cleaned up version using an array of worksheets. I also removed all of the Range.Select because they often cause more errors.

Sub test()
    'Selecting worksheets'
    Dim MyArray() As Variant, wsx As Worksheet
    
    ReDim MyArray(7 To ThisWorkbook.Worksheets.Count)

    For x = 7 To ThisWorkbook.Worksheets.Count
        Set MyArray(x) = ThisWorkbook.Worksheets(x)
    Next x
            
    'Loopin through selection of worksheets'
    For x = LBound(MyArray) To UBound(MyArray)
        'Copy/paste of data'
        Set wsx = ThisWorkbook.Worksheets(x)
        wsx.Range(wsx.Range("U9"), wsx.Range("U9").End(xlToLeft).End(xlDown)).Copy _
            Destination:=Worksheets("ConsolidatedData").Range("B1").End(xlDown).Offset(1)
    Next x
End Sub

I made this for demonstrative purposes but I agree with Tim Williams' comment. You really don't need two loops since the array is used immediately and fully. You may as well just directly reference the sheets rather than save the references and then loop through the array of references. I would rewrite it with only one loop as follows:

Sub test()
    Dim wsx As Worksheet
    'Loopin through selection of worksheets'
    For x = 7 To ThisWorkbook.Worksheets.Count
        'Copy/paste of data'
        Set wsx = ThisWorkbook.Worksheets(x)
        wsx.Range(wsx.Range("U9"), wsx.Range("U9").End(xlToLeft).End(xlDown)).Copy _
            Destination:=Worksheets("ConsolidatedData").Range("B1").End(xlDown).Offset(1)
    Next x
End Sub

When you start automating large scale data moves your approach in VBA should be different than simply recording the steps to do it in Excel. Firstly, you do not have to Select a worksheet in order to read or write to it. Indeed, all of that associated video refreshing will significantly slow your macro. It's also probably not a good idea to refer to worksheets by number, they change often. But I'll go with it for here.

To iterate through the worksheets you can write code a few ways but you'll want an outer loop that looks something like:

     Dim OutWorksheet as Worksheet, InWorksheet as Worksheet
     Dim I as integer
     Set OutWorksheet=Worksheets(7)
     For I = 8 to Worksheets.Count
          InWorksheet=Worksheets(I)
               .... Code to copy data from InWorksheet to OutWorksheet
     Next I

Any code you write inside the loop can reference InWorksheet directly without Selecting it. For example, the number of the last row with data in each sheet is InWorksheet.UsedRange.Rows.Count.

That should be enough to get you started.

this was hard to solve, try this code i just changed your way, sheetnames instead sheets as objects

replace ranges as you need

Good Luck

Sub IterateSheets()
    Dim nRowsData As Double
    Dim SheetMain As String
  
    SheetMain = "Sheet 1" '<--replace (Sheet 1) with your main sheet to consolidate data
    Dim MyArray As Variant
    MyArray = GetSelectedSheetNames
    Sheets(SheetMain).Select
'Loopin through selection of worksheets'

        For Each s In MyArray
                Sheets(s).Select
                'Copy/paste of data'
                Range("U9").Select
                Range(Selection, Selection.End(xlToLeft)).Select
                Range(Selection, Selection.End(xlDown)).Select
                Selection.Copy
                Sheets(SheetMain).Select
                nRowsData = ThisWorkbook.Application.WorksheetFunction.CountA(Range("B:B"))
                Range("B" & nRowsData + 1).Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
        Next s


End Sub

Private Function GetSelectedSheetNames() As Variant
    Dim stringResutl As String
    For   Each ws In ActiveWindow.SelectedSheets
            stringResutl = stringResutl & ws.Name & ";"
    Next ws
    stringResutl = Left(stringResutl, Len(stringResutl) - 1)
    GetSelectedSheetNames = Split(stringResutl, ";")
End Function

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM