Macro to select and copy data from multiple sheets with different names from different workbooks

[ElaineF]

Good day. I have a macro that fetches all files in a specific folder and then copies data from a specific sheet in each file. This works great. I now have to create a macro to fetch files in a folder, BUT each file has different sheet names. So, file 1 only has one sheet named "Elaine"; file 2 has three sheets named, "John", "Mark" and "Luke"; and file 3 has three sheets, but I only need the data from the one sheet named "Mandy". How do I specify the specific sheets that need to be copied, with all these differences in mind?

 

[dmt32]

Hi,
would be helpful if you post the code you want to amend.
As an idea you could create an array of sheet names that are valid & test the workbook for any matches.

try working the following into your code:

Dim sh As Worksheet
    Dim arr As Variant


    'valid sheet names to copy
    arr = Array("John", "Mark", "Luke", "Elaine")


    For Each sh In ActiveWorkbook.Worksheets


        If Not IsError(Application.Match(sh.Name, arr, False)) Then


            MsgBox "Sheet Exists"


            'do suff
        End If
    Next sh

Others may have alternative suggestions.

Hope helpful

Dave

 

[ElaineF]

Good day Dave. I will give this a go and let you know if it works.

 

[ElaineF]

Good day Dave. I can see that the different sheets are being selected, but the data is only being copied from the first sheet. How do I get it to copy and paste each sheet?

 

[dmt32]

Good day Dave. I can see that the different sheets are being selected, but the data is only being copied from the first sheet. How do I get it to copy and paste each sheet?

If not had much success adapting suggesting into your code then post what you are trying to do & I or others here should be able to assist.

Dave

 

[ElaineF]

Good day Dave. Please see code below. I have 3 files that are being opened. Two are copying and pasting successfully, but the last one is not. There are 3 sheets, in this last file, that need to be copied and pasted into the separate workbook, but it only copies and pastes the middle sheet (the one that is active as the file is opened) and it does this three times.

---

Public Function IsFileOpen(strFileName As String) As Boolean

On Error Resume Next 'Ignore any errors (i.e. if workbook is not open)

Set wrkFileName = Workbooks(strFileName)

If wrkFileName Is Nothing Then
IsFileOpen = False
Else
IsFileOpen = True
End If

On Error GoTo 0 'Nullify above error handler

End Function

---

Sub Consolidate()
Dim strDir As String, _
strThisWkb As String, _
strConsTab As String
Dim objFSO As Object, _
objFolder As Object, _
objFile As Object
Dim lngPasteRow As Long
n = Date 'today
Dim sh As Worksheet
Dim arr As Variant

strDir = "\\Location\" 'Change to suit
strThisWkb = ThisWorkbook.Name
strConsTab = "Manual" 'Change to suit

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strDir)

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

For Each objFile In objFolder.Files
'If the file in the 'strDir' directory is not this workbook, then...
If objFile.Name <> strThisWkb Then
'...check to see if it's open. If it is...
If IsFileOpen(objFile.Name) = True Then

'Else, set the 'lngPasteRow' variable and open the workbook.
Else
lngPasteRow = _
Workbooks(strThisWkb).Sheets(strConsTab).Cells(Rows.Count, "A").End(xlUp).Row + 1
Workbooks.Open Filename:=strDir & "\" & objFile.Name
'If the 'lngPasteRow' variable value is 2, then...
arr = Array("John", "Mark", "Luke", "Elaine")

For Each sh In ActiveWorkbook.Worksheets

If Not IsError(Application.Match(sh.Name, arr, False)) Then

MsgBox "Sheet Exists"

'do suff
End If
Next sh

Range("B2:G2").Select
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlUp).Offset(2, 0)).Select

Selection.Copy
Windows("Ageing Tool (Manual).xlsm").Activate
Sheets("Manual").Select
Range("B1").Select
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
On Error Resume Next
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks(objFile.Name).Activate

On Error GoTo 0

'Close the just opened file without saving any changes to it.
Workbooks(objFile.Name).Close False
End If
End If
Next objFile

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True

MsgBox "Data from each workbook in the """ & strDir & """ directory has now been imported to the """ & strConsTab & """ tab.", vbInformation, "Import Data Editor"


End Sub

 

[ElaineF]

Hi. Not to worry. I have figured it out.