Import Specific Sheet tab to Master Workbook

[navic]

I have a "Master" workbook and worksheets in it. Sometime I have two a worksheet tab named "Helper" and "Summary", but sometime I have three worksheets in it (like "Analyze", "Helper" and "Summary").
In the 'Temp' folder I have between 80 and 100 workbooks (all depends on the current month).
I want to import a specific Worksheet tab name into my master book from multiple closed workbooks in a defined/selected folder, but there are three conditions.

Conditions
1. I want to enter the name of the worksheet in the cell 'D6' to the 'helper' worksheet. This Sheet name tab, VBA macro should be used to determine which worksheet should be imported.
2. Import all data contained in the worksheet as values without formulas.
3. The imported worksheet should be named as the file name of the workbook but without the year and extension.

For example: Worksheets are named as a monthNumber-years. This '1-2019' is the month of January 2019
I want to import the Sheet "1-2019" without the formulas (The name of this worksheet is placed in the 'D6' cell on the "helper" worksheet. Note: The Data Validation drop-down menu is set in this cell).
This is variable and every month I will change this data.

Some of the workbooks in the defined folder are:
- Surname1-Name_2019.xlsx
- Surname2-Name_2019.xlsx
- Surname3-2ndSurname-Name_2019.xlsx

I want the three "1-2019" imported worksheets are named as:
- Surname1-Name
- Surname2-Name
- Surname3-2ndSurname-Name

I have this VBA macro and this macro works.
But I want to avoid the extension of the file in the name of the copied worksheet. Also if it is possible to import without formulas and use 'D6' cell.

Sub ImportSheetFromMultipleWbk()
    Dim myDir As String
    Dim fn As String
    myDir = "C:\Temp" 'defined path 
    fn = Dir(myDir & "\*.xlsx") 'format file
    Do While fn <> ""
        With Workbooks.Open(myDir & "\" & fn)
            With .Sheets("1-2019") 'How to Pull this information 1-2019 from D6 cell from "helper" worksheet and import this named sheet?
'---------------
' If possible import all data in worksheet as values without formulas
'---------------
                .Name = "" & fn & "" 'name of imported sheet like name.xlsx (Is possible without year and extension?)
                .Copy After:=ThisWorkbook.Sheets(1)
                '.Copy After:=ThisWorkbook.Sheets(3)
            End With
            .Close False
        End With
        fn = Dir
    Loop
End Sub

Can someone correct this VBA macro above? I'm using excel 2010.
or
I would be very grateful if someone has a VBA macro that has an input form for selecting a folder and enter a name for a specific sheet and meets these three conditions above.

This is too hard for me, can someone please help?

 

[DanteAmor]

Try this

Sub ImportSheetFromMultipleWbk()
    Dim myDir As String, mySheet As String, myName As String
    Dim fn As String
    
    Application.ScreenUpdating = False

    '[COLOR=#333333]selecting a folder[/COLOR]
    myDir = "C:\Temp" 'defined path
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = myDir
        If .Show <> -1 Then Exit Sub
[COLOR=#0000ff]        myDir = .SelectedItems(1)[/COLOR]
    End With


[COLOR=#0000ff]    mySheet = ThisWorkbook.Sheets("Helper").Range("D6").Value[/COLOR]
    
    fn = Dir(myDir & "\*.xlsx") 'format file
    Do While fn <> ""
        With Workbooks.Open(myDir & "\" & fn)
            myName = Left(.Name, Len(.Name) - 10)
            On Error Resume Next
[COLOR=#0000ff]            With .Sheets(mySheet)[/COLOR]
                .Name = myName
                .Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                ActiveSheet.Cells.Copy
                ActiveSheet.Range("A1").PasteSpecial Paste:=[COLOR=#0000ff]xlPasteValues[/COLOR]
            End With
            On Error GoTo 0
            .Close False
        End With
        fn = Dir()
    Loop
End Sub

 

[navic]

Thank you so much Dante.
Your VBA correction code works. They fulfill two conditions. It works, but there are several problems

1st.
I tested on three Excel files, the duration is very long. Excel needed over 20 minutes to process three files and import one worksheet. Can I imagine how much it would take when I was working with 80-100 Excel files?

2nd.
All worksheets are imported with formulas? I want to import worksheets as values ​​without formula.
Note! In each worksheet I have a formula that pulls Surname-Name from the name of the Excel file. After importing there are formulas and error.
I need without the formula but the cell format remains the same (color, merged cells, column width, column height etc)

I checked 'Microsoft Scripting RunTime' and 'Microsoft Visaual Basic for Application Extensibility 5.3'.
In other tests, I tried to force stop the VBA, then 'Debug' and the code line 'myName = Left (.Name, Len (.Name) - 10)' appeared in yellow. VBA macro in the first post, executed in a minute.

What can be a problem?
Do you have another idea of VBA macro. VBA does not have to be this way.

 

[DanteAmor]

The macro pastes values ​​and respects the format, but surely you have books that do not contain a sheet called "1-2019"
I did the test with 3 files and it takes 1 second

Try this please:

Sub ImportSheetFromMultipleWbk()
    Dim myDir As String, mySheet As String, myName As String
    Dim fn As String
    Dim wb2 As Workbook, sh2 As Worksheet, exists As Boolean
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    myDir = "C:\Temp" 'defined path
    myDir = "C:\trabajo\books" 'defined path
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = myDir
        If .Show <> -1 Then Exit Sub
        myDir = .SelectedItems(1)
    End With


    mySheet = ThisWorkbook.Sheets("Helper").Range("D6").Value
    
    fn = Dir(myDir & "\*.xlsx") 'format file
    Do While fn <> ""
        exists = False
        Set wb2 = Workbooks.Open(myDir & "\" & fn)
        For Each sh2 In wb2.Sheets
            If LCase(sh2.Name) = LCase(mySheet) Then
                exists = True
                Exit For
            End If
        Next
        If exists = True Then
            myName = Left(wb2.Name, Len(wb2.Name) - 10)
            With wb2.Sheets(mySheet)
                .Name = myName
                .Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                ThisWorkbook.Activate
                ActiveSheet.Cells.Copy
                ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
            End With
        End If
        wb2.Close False
        fn = Dir()
    Loop
    Application.CutCopyMode = False
End Sub

 

[navic]

You're right. VBA macro works. I've re-created new simple files and tested everything in is correct.
The problem was because the worksheet was password protected. But, the password is required.

Still, I have 2 problems.

1st
I forgot to mention that the worksheet is protected by a password. When I removed the password, everything is OK.
Can you add the VBA code in the VBA macro from your first post, remove the password before copying, and the imported sheet will be left without password.

2nd
On a sheet tab that I want to import, there is one cell containing a formula that pulls Surname and Name from the file name.
When I import a sheet tab, error #VALUE appears in this cell!
How to avoid it? I do not know why macro did not import this cell as a value?

Thank you again, best regards.

 

[DanteAmor]

You're right. VBA macro works. I've re-created new simple files and tested everything in is correct.
The problem was because the worksheet was password protected. But, the password is required.

Still, I have 2 problems.

1st
I forgot to mention that the worksheet is protected by a password. When I removed the password, everything is OK.
Can you add the VBA code in the VBA macro from your first post, remove the password before copying, and the imported sheet will be left without password.

2nd
On a sheet tab that I want to import, there is one cell containing a formula that pulls Surname and Name from the file name.
When I import a sheet tab, error #VALUE appears in this cell!
How to avoid it? I do not know why macro did not import this cell as a value?

Thank you again, best regards.

Try this please

Sub ImportSheetFromMultipleWbk()
    Dim myDir As String, mySheet As String, myName As String
    Dim fn As String
    Dim wb2 As Workbook, sh2 As Worksheet, exists As Boolean
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    myDir = "C:\Temp" 'defined path
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = myDir
        If .Show <> -1 Then Exit Sub
        myDir = .SelectedItems(1)
    End With


    mySheet = ThisWorkbook.Sheets("Helper").Range("D6").Value
    
    fn = Dir(myDir & "\*.xlsx") 'format file
    Do While fn <> ""
        exists = False
        Set wb2 = Workbooks.Open(myDir & "\" & fn)
        For Each sh2 In wb2.Sheets
            If LCase(sh2.Name) = LCase(mySheet) Then
                exists = True
                Exit For
            End If
        Next
        If exists = True Then
            myName = Left(wb2.Name, Len(wb2.Name) - 10)
            With wb2.Sheets(mySheet)
                .Unprotect  'remove protect
                .Name = myName
                .Cells.Copy
                .Range("A1").PasteSpecial Paste:=xlPasteValues
                .Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            End With
        End If
        wb2.Close False
        fn = Dir()
    Loop
    Application.CutCopyMode = False
End Sub

 

[navic]

Try this please

It works right now.
If there is a problem, I'll be here.
Dante, thank you very much!
With respect, best regards

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

If you have a problem I will also be here.