VBA copy only green tabs from closed WB to a new WB

[gubertu]

Hi all,

I hope you can help me with the following code I need.

I have 10 different WBs in a folder, let´s say C:\Users\Downloads.

I would like to have a code that goes into every closed WB in the folder and copy only the green colour sheets into a new WB.

For example:

WB 1 name: Debt
Number of sheets: 5 sheets in the WB, only one sheet is green coloured, called "Summary".

WB 2 name: Assets
Number of sheets: 3 sheets in the WB, only one sheet is green coloured, called "Assets".

Final result:

I would like to create a new WB, with only the two sheets green colour, in this case, "Summary" and "Assets".

Thanks in advance for your help!

 

[gubertu]

​

I've just read again your initial post (sorry I didn't remember the path was there) and now I'm in a doubt :​

your attachment contains only two workbooks but your initial post stated about ten workbooks so what is the purpose ?​

To open only two specifics workbooks of ten (aka Assets & Debt) or to open all workbooks for specific worksheets names ?​

If it's the second case then well described the expected result 'cause what if several workbooks contains the same worksheets names ?​

Hello,

For the moment, I only need to extract the sheets Debt and Assets from those two WB and put them together.

Is it that possible?

Thanks for your help!

 

[Marc L]

According to your attachment a VBA demonstration for starters :​

Function ExistWorkbookSheet(BOOK, SHEET) As Boolean
                      Dim V
                          V = Evaluate("ISREF('[" & BOOK & "]" & SHEET & "'!A1)")
         ExistWorkbookSheet = IIf(IsError(V), False, V)
End Function

Sub Demo1()
  Const P = "C:\Users\Downloads\"
    Dim V, Wb As Workbook, R&
        V = [{"Assets.xlsx","Assets";"Debt.xlsx","Summary"}]
    With Application
       .ScreenUpdating = False
       .SheetsInNewWorkbook = 1
        Set Wb = Workbooks.Add
    For R = 1 To UBound(V)
        If Dir(P & V(R, 1)) > "" Then
            With Workbooks.Open(P & V(R, 1))
                If ExistWorkbookSheet(V(R, 1), V(R, 2)) Then
                   .Sheets(V(R, 2)).Copy , Wb.Sheets(Wb.Sheets.Count)
                    With Wb.Sheets(Wb.Sheets.Count).UsedRange:  .Formula = .Value2:  End With
                End If
                   .Close
            End With
        End If
    Next
        If Wb.Sheets.Count < 3 Then Beep
        If Wb.Sheets.Count > 1 Then .DisplayAlerts = False: Wb.Sheets(1).Delete: .DisplayAlerts = True Else Wb.Close
       .ScreenUpdating = True
    End With
        Set Wb = Nothing
End Sub

 

[gubertu]

Hello!

The code seems to work pefect for two files, however, I would like to include the following. Please tell me if that is possible.

1) I have 10 files, instead of 2.
In order to edit the code, I imagine I should modify the following line

V = [{"Assets.xlsx","Assets";"Debt.xlsx","Summary"}]"

What else should I change to adapt the code for 10 files?


2) The file names (in the example "Debt" and "Assets") has the following ending:
"Debt.0821" and "Assets.0821" for the month of August.
"Debt.0921" and "Assets.0921" for the month of September.
With this code, I would need to change the file names every month (replace 0821 for 0921, in the example). Is there a possibily that the code find the file for the 4 first words?

Thanks a lot for your help

 

[Marc L]

Is there a possibily that the code find the file for the 4 first words?

See the VBA function Dir using wildcards …​

 

[gubertu]

I have modified the code a bit. Now I can open 3 files; However, I´m trying to use the wildcards in Dir function but it is not working.

Could you please help me?

Thanks a lot!

Sub Macro_Modificada_Funciona()
  Const P = "C:\Users\Downloads\REPORTING SEPT 2021\"
    Dim V, Wb As Workbook, R&
        V = [{"Debt_08.2021.xlsx","1";"Deferred tax_08.2021.xlsx","2";"Fix Assets_09.2021.xlsx","3"}]
    With Application
       .ScreenUpdating = False
       .SheetsInNewWorkbook = 2
        Set Wb = Workbooks.Add
    For R = 1 To UBound(V)
        If Dir(P & "*" & V(R, 1) & "*") > "" Then
            With Workbooks.Open(P & V(R, 1))
                If ExistWorkbookSheet(V(R, 1), V(R, 2)) Then
                   .Sheets(V(R, 2)).Copy , Wb.Sheets(Wb.Sheets.Count)
                    With Wb.Sheets(Wb.Sheets.Count).UsedRange:  .Formula = .Value2:  End With
                End If
                   .Close
            End With
        End If
    Next
        If Wb.Sheets.Count < 3 Then Beep
        If Wb.Sheets.Count > 1 Then .DisplayAlerts = False: Wb.Sheets(1).Delete: .DisplayAlerts = True Else Wb.Close
       .ScreenUpdating = True
    End With
        Set Wb = Nothing
End Sub

 

[Marc L]

​

Should be Dir(P & V(R, 1) with in V array for example "Debt_*.xlsx" …​

​

No need the If block anymore as Dir must be used within some loop like demonstrated in its VBA help …​

 

[gubertu]

Hello,

I tried do it but the code didn´t work. Could you please give me some code example please?

Thanks in advance!

 

[gubertu]

Hello!

Any help?

Thanks