Merging "Same Named" Worksheets from 5 different Workbooks (1 Variable Column Header)

[cliniconboarding]

[FONT=&quot]I currently use the below code to split data by provider last name, from a list of quality metrics that are due.[/FONT]
[FONT=&quot]
[/FONT]
[FONT=&quot]This is a multistep process to trim the csv file I receive with 60 columns of data and a variable number of rows, down to the 9 columns of data that I have sorted by what is actually due, split by each provider onto a worksheet named "Their last name". That process is now perfected (Thanks to Fluff on a recent post).[/FONT]

Sub parse_NonPCProviders()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer


MsgBox (" Brace yourself for this one. You may need to walk away for a bit. ")


vcol = 4
Set ws = Sheets("ADD")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:H1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A" & Rows.Count).End(xlUp).Offset(1)
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
MsgBox (" Yeah, you thought it was going to crash didn't you? ")


End Sub

[FONT=&quot]
[/FONT]
[FONT=&quot]
[/FONT]
[FONT=&quot]Now I'm just tidying up however and I’m left with 5 separate workbooks, one for each quality metric and currently I’ll have to print them all, sort, and staple per provider (Not the end of the world). Though, I'd love to save some paper and time and merge them together.

Given this,

There are two things I'm bumping into:[/FONT]

1. Since the quality metrics differ, the header in one column is different on each workbook (with the name of the metric numerator).
2. The names on the sheets might not be the same.
   1. What I mean by this, is that out of our providers we have say: Amy, Bob, Charlie, Dave, Evan
      1. But on one metric only Amy, Bob, Charlie had anything due. So they’re the only ones with worksheets.
      2. And on another everyone has something due.
      3. On another it might only be Bob, Dave, Evan

[FONT=&quot]
[/FONT]
[FONT=&quot] I've created a master with every possible name (about 50), and tried to run the following code referencing a source file where everything was placed together: I received no errors and I got my little message box, yet nothing happened. My preference would be that it simply reference whatever Excel documents were open and pulled them into the active workbook. Including the header from their respective sheet (to identify which metric it references) into the next available line. Not sure if I should be trying to do something with vblookup here? Any guidance is appreciated, ya'll are like textbooks of knowledge!

[/FONT]
S

ub Copy_From_All_Workbooks()
    Dim wb As String, i As Long, sh As Worksheet
    Application.ScreenUpdating = False
wb = Dir(ThisWorkbook.Path & "\*")
  
    Do Until wb = ""
        If wb <> ThisWorkbook.Name Then
            Workbooks.Open ThisWorkbook.Path & "\*" & wb
                For Each sh In Workbooks(wb).Worksheets
                        sh.UsedRange.Copy    '<---- Assumes all header rows
                            ThisWorkbook.Sheets(sh.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                        Application.CutCopyMode = False
                Next sh
            Workbooks(wb).Close False
        End If
        wb = Dir
    Loop
    Application.ScreenUpdating = True
       MsgBox "All worksheets have been copied successfully"
End Sub

 

[JLGWhiz]

See if this works better

Sub Copy_From_All_Workbooks2()
    Dim wb As Workbook, fName As String,  sh As Worksheet
    Application.ScreenUpdating = False
    fName = Dir(ThisWorkbook.Path & "\*.xl*")
  
    Do Until fName = ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & fName)
                For Each sh In wb.Worksheets
                        sh.UsedRange.Copy    '<---- Assumes all header rows
                            ThisWorkbook.Sheets(sh.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                        Application.CutCopyMode = False
                Next sh
            wb.Close False
        End If
        fName = Dir
    Loop
    Application.ScreenUpdating = True
       MsgBox "All worksheets have been copied successfully"
End Sub

 

[cliniconboarding]

Hmm. Still end up with blank worksheets. I get no error at all. It runs the code and I get the message box implying that it has completed the function to no avail. I'll give it a go on a different computer and report back.

 

[JLGWhiz]

Hmm. Still end up with blank worksheets. I get no error at all. It runs the code and I get the message box implying that it has completed the function to no avail. I'll give it a go on a different computer and report back.

Make sure the code is not in a sheet code module. It should be in a public module. It is possible that this line

ThisWorkbook.Sheets(sh.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues

is the problem. You can open the vbeditor and use the F8 key to step through the code to see if the code is returning the correct sheet name when that line executes. If the destination workbook does not contain a sheet with the source sheet's name, it would not be able to paste. But it also should give an error. But that would be my first place to look for the problem.

 

[cliniconboarding]

When I step through it I'm getting a value of "nothing" for 'wb' and for 'sh', though I'm not totally sure where to go from here. Maybe there is an easier way to attempt this all together?

 

[JLGWhiz]

When I step through it I'm getting a value of "nothing" for 'wb' and for 'sh', though I'm not totally sure where to go from here. Maybe there is an easier way to attempt this all together?

The code I suggested is using the directory path for the host workbook as the path for the called workbook. If those two workbooks are in a separate directory, then wb would return Nothing because it could not set the variable to a value. but it also should have triggered 'Subscript out of rangee' error. Same for the sh variable. It cannot initialized unless the wb variable is initialized. Are the two workbooks in the same directory? If not, then the Path to open the second workbook will need to be used instead of 'ThisWorkbook' path.

The code works if all the workbooks are in the same directery. At least it did on my system.

 

[cliniconboarding]

They're all in the same directory. I've pulled it onto my husband's computer and it works perfectly. It's something about the way I'm writing the file directory since I've switched to Mac from PC. Because on his PC there is no problem.

Having said that. Your above code is perfect! Just not on my MacBook for whatever reason

 

[JLGWhiz]

They're all in the same directory. I've pulled it onto my husband's computer and it works perfectly. It's something about the way I'm writing the file directory since I've switched to Mac from PC. Because on his PC there is no problem.

Having said that. Your above code is perfect! Just not on my MacBook for whatever reason

That's the answer, Mac does not use the same syntax in many cases as PC. I have not worked with Mac, so I can't be of much help there. Thanks for the feedback.
Regards, JLG

 

[JLGWhiz]

Ron DeBruin has some good info here that might help you get the code to work on the Mac.

http://www.rondebruin.nl/mac/mac013.htm