Copy data only from worksheets that name matches an item in array.

[Smurphy820]

What I need to do is go through the prior month's workbook and pull data from only the worksheets that have the same name as the worksheets in the current month's workbook. I started out by saving all of the current month's worksheet names into a list. But from there I am kind of stuck on where to go next.

For Each ws In ActiveWorkbook.Worksheets

If (UCase(ws.Name) Like "ASM*") And (UCase(ws.Name) <> "ASM MAIN") Then



Sheettitle1 = ws.Name

SheettitleArray = Split(Sheettitle1, "_")

Sheettitle = SheettitleArray(1)



ws.Range("E23:E32").Formula = "=VLOOKUP($B23, '[" & Name & "]" & Sheettitle & "'!$A$3:$E$261,3,FALSE)"



ws.Range("F23:F32").Formula = "=VLOOKUP($B23, '[" & Name & "]" & Sheettitle & "'!$A$3:$E$261,4,FALSE)"



ws.Range("G23:G32").Formula = "=VLOOKUP($B23, '[" & Name & "]" & Sheettitle & "'!$A$3:$E$261,5,FALSE)"



Sheets("ASM Main").Cells(Rows.Count, "A").End(xlUp).Offset(2, 0) = ws.Name



'

ws.Range("A6").CurrentRegion.Copy

Worksheets("ASM Main").Cells(Rows.Count, "A").End(xlUp).Offset(2, 0).PasteSpecial Paste:=xlPasteValues



Worksheets("Macros").Select

Range("X7").CurrentRegion.Select

Selection.Copy

Worksheets("ASM Main").Select

Cells(Rows.Count, "A").End(xlUp).Offset(-12, 20).Select

ActiveSheet.Paste



List(x) = ws.Name ' creates the list 



x = x + 1




End If



Next ws



folderpath = "C:\Users\XXXX\XXX\Documents\XXXX\XXXX\" & newDate & "\" ' open the prior months excel



sFound = Dir(folderpath & "*PriorDoc.xlsx")

If sFound <> "" Then

Workbooks.Open Filename:=folderpath & "\" & sFound

Name = ActiveWorkbook.Name

End If

The code above is a snippet of the part that gives me a list of all of the worksheets I want to compare to the prior month's workbook. Below is an example for the worksheet the code above just opened ("PriorDoc"). I need to go through these worksheets and copy the data table starting at cell A6. The table is in the same location every time.

Then I have to paste the data tables from only the worksheets that match into the current month's "ASM main" worksheet on top of one another like below. Is this possible? Thanks!

 

[Alex Blakenburg]

I don't see any point in loading the sheet names to an array first. If you had a large number of worksheets we could consider loading it into a dictionary.

See if the below works for you. To test it I commented out your current "For each ws".
Apart from set up statements my code is in the "For each priorWs" loop.

Sub Test_CopySheets()

    Dim currWb As Workbook, priorWb As Workbook
    Dim ws As Worksheet, priorWs As Worksheet, mainWs As Worksheet
    Dim folderpath As String, sFound As String
    Dim Sheettitle As String, Sheettitle1 As String
    Dim SheettitleArray As Variant
    Dim mainNextRow As Long
    Dim sCopyAddr As String, priorCpyRng As Range
    
    Application.ScreenUpdating = False

    Set currWb = ActiveWorkbook
    Set mainWs = currWb.Worksheets("ASM Main")
    
    
    For Each ws In currWb.Worksheets

        If (UCase(ws.Name) Like "ASM*") And (UCase(ws.Name) <> "ASM MAIN") Then
            Sheettitle1 = ws.Name

            SheettitleArray = Split(Sheettitle1, "_")
            Sheettitle = SheettitleArray(1)
            ws.Range("E23:E32").Formula = "=VLOOKUP($B23, '[" & Name & "]" & Sheettitle & "'!$A$3:$E$261,3,FALSE)"
            ws.Range("F23:F32").Formula = "=VLOOKUP($B23, '[" & Name & "]" & Sheettitle & "'!$A$3:$E$261,4,FALSE)"
            ws.Range("G23:G32").Formula = "=VLOOKUP($B23, '[" & Name & "]" & Sheettitle & "'!$A$3:$E$261,5,FALSE)"

            Sheets("ASM Main").Cells(Rows.Count, "A").End(xlUp).Offset(2, 0) = ws.Name

            ws.Range("A6").CurrentRegion.Copy

            Worksheets("ASM Main").Cells(Rows.Count, "A").End(xlUp).Offset(2, 0).PasteSpecial Paste:=xlPasteValues

            Worksheets("Macros").Select

            Range("X7").CurrentRegion.Select

            Selection.Copy

            Worksheets("ASM Main").Select

            Cells(Rows.Count, "A").End(xlUp).Offset(-12, 20).Select

            ActiveSheet.Paste
            List(x) = ws.Name ' creates the list
            x = x + 1

        End If

    Next ws
      
    folderpath = "C:\Users\XXXX\XXX\Documents\XXXX\XXXX\" & newDate & "\" ' open the prior months excel

    sFound = Dir(folderpath & "*PriorDoc.xlsx")
   
    If sFound <> "" Then
    
        Workbooks.Open Filename:=folderpath & "\" & sFound
        Set priorWb = ActiveWorkbook
        sCopyAddr = "A6:I17"                    ' <---- We could make this dynamic
        
        For Each priorWs In priorWb.Worksheets
            If (UCase(priorWs.Name) Like "ASM*") And (UCase(priorWs.Name) <> "ASM MAIN") Then

                Set ws = Nothing
                On Error Resume Next
                    Set ws = currWb.Worksheets(priorWs.Name)
                On Error GoTo 0
                If Not ws Is Nothing Then
                    ' Copy data
                    mainNextRow = mainWs.Cells(mainWs.Rows.Count, "A").End(xlUp).Row + 2
                    Set priorCpyRng = priorWs.Range(sCopyAddr)
                    mainWs.Cells(mainNextRow, "A").Value = priorWs.Name
                    mainNextRow = mainNextRow + 3
                    mainWs.Cells(mainNextRow, "A").Resize(priorCpyRng.Rows.Count, priorCpyRng.Columns.Count).Value = priorCpyRng.Value
                End If
            
            End If
        
        Next priorWs
        priorWb.Close SaveChanges:=False
        mainWs.UsedRange.Columns.AutoFit
        
    End If
    
    Application.ScreenUpdating = True

End Sub

 

[Smurphy820]

Sorry I realized that I created a List not an Array. This code is at the end of the first For Each loop.

List(x) = ws.Name
           
 x = x + 1

Is it possible to adjust the code so the second For Each loop looks for just these names in the prior month's workbook? Just using the (UCase(ws.Name) Like "ASM*") will bring in tabs I don't need. Also is there a better way to create a list/array then the way I used?

Thank you much appreciated!!!

 

[Alex Blakenburg]

Is it possible to adjust the code so the second For Each loop looks for just these names in the prior month's workbook?

Can you elaborate ? I thought that you didn't want to hard code the Sheet names to be copied but were relying the sheet name starting with ASM and being in both the old and the new workbook with the exception being ASM_Main.
If you want to hard code sheet names you could just use in if statement or a Select Case eg.

        Select Case priorWs.Name
       
            Case "ASM_02-2022", "ASM_03-2022", "ASM_04-2022"
                ' run code
            Case Else
                ' Do nothing
        End Select

is there a better way to create a list/array then the way I used?

What are you tring to achieve with your list/array ? I would have thought your current code doesn't actually work unless you have "list" dimensioned somewhere and not included it in the code you posted. (I also didn't see "Name" being assigned a value)
For what you were asking for in terms of copying data from the various sheets, it served no purpose. So I need to know what you are trying to do with the list.

PS: It is not a good idea to use variable names such as "Name" & "List" they are terms used in VBA.