PDA

View Full Version : Need Help: Import worksheets by name using an array of defined names



minuteman
03-29-2017, 08:00 PM
I have a list of Excel Worksheet Names in a table 18804 . The table is titled "asap[ASAP_Worksheets]"
Column Header: ASAP_Worksheets
Column Values:

XES
Sencore
Trend Micro
4DSP
Datacard
Sound Devices
Vex
New Wave
Boxcast
Westell


I have some VBA (below) which dives into a folder, opens all of the Excel Workbooks and copies all of the Worksheets into a single Workbook. I want to copy ONLY the Worksheets by Name that are listed in my table above. The contents of the above table will change weekly, thus the need for the dynamic table reference of "asap[ASAP_Worksheets]" rather than a static range like A2:A11. Any help would be extremely appreciated, there is no solution that I could find on the web after many hours of research.



Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet

Application.ScreenUpdating = False
FolderPath = "../folder path"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets

' This is where I need to insert some additional code to check against the array before executing the next line of code which performs the copy function.

Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True

End Sub



I also created this Array which pulls the above table values into an array, but I could not figure out how to pass these values into a filter to then identify and copy over only the named sheets. This may or may not help.

Sub TestArray()
Dim Arr() As Variant
Arr = Range("asap[ASAP_Worksheets]")
Dim Row As Long
Dim Col As Long
For Row = 1 To UBound(Arr, 1)
For Col = 1 To UBound(Arr, 2)
Debug.Print Arr(Row, Col)
Next Col
Next Row
End Sub

snb
03-30-2017, 12:02 AM
SUb M_snb()
sn=sheets(1).columns(1).specialcells(2)

for j=2 to ubound(sn)
sheets.add ,sheets(sheets.count),,sn(j,1)
next
End Sub

mdmackillop
03-30-2017, 02:26 AM
Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Dim Arr() As Variant
Dim x As Boolean

Arr = Range(Sheets("ASAP").Columns(1).SpecialCells(2).Address)
Application.ScreenUpdating = False
FolderPath = "C:\VBAX\" '@@@@@@@@@@@@@@@@@@@
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
x = IsError(Application.Match(Sheet.Name, Arr, 0))
If Not (x) Then Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close False
Filename = Dir()
Loop
Application.ScreenUpdating = True

End Sub

rlv
03-30-2017, 07:07 AM
Another approach (not tested)


Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet


Application.ScreenUpdating = False
FolderPath = "../folder path"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets

'new code
If Not IsError(Application.VLookup(Sheet.Name, Range("asap"), 1, False)) Then
Sheet.Copy After:=ThisWorkbook.Sheets(1) 'Copy Worksheet
End If

Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub

mdmackillop
03-30-2017, 07:53 AM
You can also create a Dynamic range name using the offset function
=OFFSET(ASAP!$A$1,1,0,COUNTA(ASAP!$A:$A)-1,1)

snb
03-30-2017, 08:10 AM
@mdmac

In VBA :


sheets(1).cells(1).currentregion.columns(1)

mdmackillop
03-30-2017, 08:17 AM
@SNB
Thanks. The cat is well and truly skinned!
I used the SpecialCells version in my code; was just passing on the Offset usage for information.
Regards
MD