Help looping thru multiple workbooks to merge data into Masterr worksheet

[kfschaefer]

I am having issues with the data being placed in the master workbook which contains multiple worksheets that have data tables In one case if SHNames = "Proj Sum" then it is placed outside of the table and not recognized by Pivot table, the other if the shName = "ResPlan_Data", there are multiple rows of blank lines in the Table and no data is updated.

Please help to correct the code accordingly. Sample file available on request , it too large to post here.

 
'************** Code Start **************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft
'*****************************************
Private Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type
 
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pidl As Long, _
            ByVal pszPath As String) As Long
 
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
            As Long
 
Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
  Dim X As Long, bi As BROWSEINFO, dwIList As Long
  Dim szPath As String, wPos As Integer
 
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
 
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
 
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function

'**************************************
'Merges all workbooks into Master Template workbook
'*************************************
Public Function MergeMultipleSheets()
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceRcount As Long, FNum As Long
    Dim myBook As Workbook, wbMaster As Workbook
    Dim BaseWks As Worksheet, ws As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim rnum As Long, CalcMode As Long
    Dim rng As Range, SearchValue As String
    Dim FilterField As Integer, RangeAddress As String
    Dim ShName As Variant, ShNames As Variant, RwCount As Long
    Dim nFilter As String
    Dim currentrow As Long
    Dim LastRow As Long
 
    MyPath = ThisWorkbook.Sheets("Data Input").Range("B1")
  '  ShNames = Array("ProjSum", "FinSum", "CommSum", "InvPlan", "ResPlan")
    ShNames = Array("ProjSum", "ResPlan_Data")
 
    Set wbMaster = ActiveWorkbook
    '**********************************
    'Merge data into existing worksheets in this workbook
    '**********************************
 
    ' Add a slash after MyPath if needed.
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If
 
    ' If there are no Excel files in the folder, exit.
    'FilesInPath = Dir(MyPath & "week*.xl*")
 
    nFilter = ThisWorkbook.Sheets("Data Input").Range("B2")
    If nFilter = "" Or FilesInPath = "" Then
        FilesInPath = Dir(MyPath & "*.xl*")
    End If
 
 
    ' Fill the myFiles array with the list of Excel files in the
    ' folder.
    FNum = 0
    Do While FilesInPath <> ""
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        MyFiles(FNum) = FilesInPath
        FilesInPath = Dir()
    Loop
 
    ' Change application properties.
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    ' Clear data from summary worksheets
    For Each ShName In ShNames
        Set rng = Nothing
        On Error Resume Next
        Set rng = wbMaster.Worksheets(ShName).UsedRange
        On Error GoTo 0
        If Not rng Is Nothing Then
            Set rng = rng.Offset(1, 0)        'Don't delete header labels in the first row
            rng.EntireRow.Delete
        End If
    Next
 
    rnum = 1
 
    ' Loop through all files in the myFiles array.
    If FNum > 0 Then
        For FNum = LBound(MyFiles) To UBound(MyFiles)
            Set myBook = Nothing
            On Error Resume Next
            Set myBook = Workbooks.Open(MyPath & MyFiles(FNum), UpdateLinks:=0)
 
     '*************************************
     'Removes unused Named Ranges from Name Manager from the Various JC files to prevent error dialogs.
     '**************************************
               For Each nName In Names
                    If InStr(1, nName.RefersTo, "#REF!") > 0 Then
                        nName.Delete
                    End If
                    If InStr(1, nName.RefersTo, "https://") > 0 Then
                        nName.Delete
                    End If
                Next nName
            On Error GoTo 0
 
            If Not myBook Is Nothing Then
 
                For Each ShName In ShNames
                    Set ws = Nothing
                    On Error Resume Next
                    Set ws = myBook.Worksheets(ShName)
                    On Error GoTo 0
     '*************************************
     'Calls function to update ResPlan in active workbook
     'Executes Updating of the ResPlan data to proper format for extraction of data in correct format
    '***************************************
                    If ShName = "ResPlan_Data" Then
                        Call UnpivotResPlan
                        myBook.Save
                     End If
                  '**************************************
                  'Updates template data per shName
                  '**************************************    
                    If Not ws Is Nothing Then
                        Set BaseWks = wbMaster.Worksheets(ShName)
                        Set sourceRange = ws.UsedRange
                        Set rng = sourceRange.Offset(1, 0).Resize(sourceRange.Rows.Count - 1, sourceRange.Columns.Count)    'Exclude header labels
 
                        RwCount = rng.Rows.Count
                        rnum = BaseWks.Cells(BaseWks.Rows.Count, 1).End(xlUp).Row + 1
 
                        BaseWks.Cells(rnum, "A").Resize(RwCount).Value _
                              = myBook.Name
                        BaseWks.Cells(rnum, "B").Resize(RwCount, rng.Columns.Count).Value = rng.Value
                    End If
                Next
                    ' Close the workbook without saving.
                    myBook.Close savechanges:=True
            End If
        ' Open the next workbook.
        Next FNum
 
    Call UnpivotSalaryDetail
        ' Set the column width in the new workbook.
        BaseWks.Columns.AutoFit
    End If
 
    ActiveWorkbook.Model.Refresh
        If Worksheets("Resplan_Data").Visible = True Then
            Worksheets("Resplan_Data").Visible = False
        End If
    Call Reset
        MsgBox "Update Completed!"
    ' Restore the application properties.
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
End Function
 

Sub UnpivotResPlan()
    Unpivot Worksheets("ResPlan")
 
End Sub

Sub UnpivotSalaryDetail()
    Dim wsDest As Worksheet
 
    Unpivot Worksheets("SalaryDetail")
End Sub

Sub Unpivot(wsSource As Worksheet)
    Dim i As Long, ii As Long, j As Long, k As Long, nn As Long, nCols As Long, nFix As Long, nRows As Long
    Dim rgPT As Range, rgPTvals As Range, rw As Range
    Dim wsDest As Worksheet
    Dim vSource As Variant, vResults As Variant
 
On Error Resume Next
    Application.EnableCancelKey = xlDisabled
 
    With wsSource.Parent
        Set wsDest = .Worksheets(wsSource.Name & "_Data")
        If wsSource Is Nothing Then Exit Sub
 
        If wsDest Is Nothing Then
            Set wsDest = .Worksheets.Add(After:=wsSource)
            wsDest.Name = wsSource.Name & "_Data"
        Else
            wsDest.Cells.ClearContents
        End If
    End With
 
On Error GoTo 0
 
    With wsSource
        Set rgPT = .Range("A2").CurrentRegion
        nCols = Application.Count(rgPT.Rows(2))
        nFix = rgPT.Columns.Count - nCols
        Set rgPTvals = rgPT.Offset(0, nFix).Resize(rgPT.Rows.Count, nCols)
        nRows = rgPT.Rows.Count
    End With
 
        nn = Application.CountIf(rgPTvals, "<>0")
        ReDim vResults(1 To nn + 1, 1 To nFix + 2)
        vSource = rgPT.Value
            For k = 1 To nFix
                vResults(1, k) = vSource(1, k)
            Next
        vResults(1, nFix + 1) = "Dates"
        vResults(1, nFix + 2) = "Values"
 
        ii = 1
        For i = 2 To nRows
            For j = 1 To nCols
                If vSource(i, j + nFix) <> 0 Then
                    ii = ii + 1
                    For k = 1 To nFix
                        vResults(ii, k) = vSource(i, k)
                    Next
                    vResults(ii, nFix + 1) = vSource(1, j + nFix)
                    vResults(ii, nFix + 2) = vSource(i, j + nFix)
                End If
            Next
        Next
 
    wsDest.Cells(1, 1).Resize(nn + 1, nFix + 2).Value = vResults
    wsDest.UsedRange.EntireColumn.AutoFit
    wsDest.Visible = True
        wsDest.Activate
        If wsDest.Range("A1").Value Like "Sale" & "*" Then
            wsDest.Columns("A:A").Select
            Selection.Delete Shift:=xlToLeft
        End If
        If wsDest.Range("A1").Value Like "Res" & "*" Then
            wsDest.Columns("D:D").Select
            Selection.NumberFormat = "m/d/yyyy"
            wsDest.Columns("E:E").Select
            Selection.NumberFormat = "#,##0.00"
        End If
        If wsDest.Name = "SalaryDetail_Data" Then
            wsDest.Columns("c:c").Select
            Selection.NumberFormat = "m/d/yyyy"
            wsDest.Columns("d:d").Select
            Selection.NumberFormat = "#,##0.00"
            wsDest.Visible = xlSheetHidden
        End If
End Sub

[zmbd]

What I don't see is where you are actually appending anything to the named pivot table.
Two links:
+ Creating PivotTable Reports and Charts with VBA in Excel 2010
This article should still be valid for Ex2013. I include it here so that you can see the basic methodology for working with pivot tables within VBA

Because it sounds like you already have the pivot tables created then you need to really understand:
+ PivotTable Object (Ex2013)
so that you can actually append the data to the desired pivot table.

Once YOU have revised YOUR code post back with the revisions and we'll take a another look.

(You may want to look at this thread too:
Linking tables to make Pivot Table Excel 2010
We were using a workbook as the back-end to the pivot table, and though not ideal, maybe something worth consideration. MORE IMPORTAINTLY, the project shows how to setup and manipulate the pivot tables in VBA!