CODEWITHSUNDEEP
excelvba
user20114520
user20114520

Reputation:

Search through closed workbook for worksheets with specific name then make copies of that sheet into active workbook

I have a code that currently opens the closed workbook titled "Specification and Configuration Document.xlsx", now I need it to look for any sheets within this closed workbook that have the value wsName which changes as the for loop progresses. The main part of this code operates in the active workbook titled "SD093_W.xlsm", sysnum variable is produced as the code loops through column E searching for unique values. If a unique value is found then it looks at Column D cell in the same row as Column E and reads the value then assigned to variable wsName.

Once the wsName value has been determined, I need the code to look in the closed workbook "Specification and Configuration Document.xlsx"and make a copy of the wsName. For example say the wsName found in the active Workbook is Test2 then I want to go into the closed workbook, search for the worksheet titled Test2, make a copy of it, and then paste it into the active workbook and rename it the value of sysnum.

This is what I have so far for my code: Any help would be greatly appreciated.

 Global sysrow As Integer, sysnum As String, wsName As String

 Public Sub Main()
 Dim wb As Workbook, ws As Worksheet, i As Range, dict As Object ', wsName As String

 Set wb = ThisWorkbook
 Set ws = wb.Worksheets("Sheet1")

 Set dict = CreateObject("scripting.dictionary")
 For Each i In ws.Range("E2:E15").Cells ' i = every WD number
     sysnum = i.value
     sysrow = i.Row
     syscol = i.Column
    If sysnum = "" Then
        On Error Resume Next
    End If
If Not dict.Exists(sysnum) Then ' check if unique value already exists before adding it to dictionary
    dict.Add sysnum, True
    If Not SheetExists(sysnum) Then
        wsName = i.EntireRow.Columns("D").value ' sheet to be copied
        If SheetExists(wsName) Then ' if there is a sheet for wsName to copy
          wb.Worksheets(wsName).Copy After:=ws ' copy the sheet
            wb.Worksheets(ws.Index + 1).name = sysnum ' rename the copy
        End If
    Else
        MsgBox "Sheet " & sysnum & " already exists"
    End If
End If

specmin = Application.Match("SPEC min", Worksheets(sysnum).Range("A2:Q2"), 0) ' column index for SPEC min in SD tab
    IsError (specmin)
specmax = Application.Match("SPEC max", Worksheets(sysnum).Range("A2:Q2"), 0) ' column index for SPEC max in SD tab
    IsError (specmax)
formula = Application.Match("Formula / step size", Worksheets(sysnum).Range("A2:Q2"), 0)
    IsError (formula)

 Next i
 End Sub

 ' check does a sheet named wsName exist in default current Workbook
 Function SheetExists(SheetName As String)
   Dim wb As Workbook, filepath As String
   filepath = "Specification and Configuration Document.xlsx"
   If wb Is Nothing Then Set wb = Workbooks.Open(filename:=filepath) 'ThisWorkbook
   On Error Resume Next
   SheetExists = Not wb.Sheets(SheetName) Is Nothing
 End Function

Upvotes: 0

Views: 186

Answers (1)

Tim Williams
Tim Williams

Reputation: 166196

Following on from comment above:

Dim sysrow As Long, syscol As Long, sysnum As String, wsName As String

Public Sub Main()
    Dim wb As Workbook, ws As Worksheet, i As Range, dict As Object ', wsName As String
    Dim wbSrc As Workbook
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")
    
    'pass the full path and filename, or (eg) use `Thisworkbook.Path`
    Set wbSrc = Workbooks.Open("C:\Temp\Specification and Configuration Document.xlsx")
    
    Set dict = CreateObject("scripting.dictionary")
    For Each i In ws.Range("E2:E15").Cells ' i = every WD number
        sysnum = i.Value
        sysrow = i.Row
        syscol = i.Column
        If Len(sysnum) > 0 Then
            If Not dict.Exists(sysnum) Then
                dict.Add sysnum, True
                If Not SheetExists(sysnum, wb) Then
                    wsName = i.EntireRow.Columns("D").Value ' sheet to be copied
                    If SheetExists(wsName, wbSrc) Then ' if there is a sheet for wsName to copy
                        wbSrc.Worksheets(wsName).Copy After:=ws ' copy the sheet
                        wb.Worksheets(ws.Index + 1).Name = sysnum ' rename the copy
                    End If 'wsName sheet exists
                Else
                    MsgBox "Sheet " & sysnum & " already exists"
                End If   'sysnum sheet exists
            End If       'new sysnum value
            '....
        End If 'sysnum not zero-length
    
    Next i
End Sub

'Does a sheet named `wsName` exist in Workbook `wb` ?
Function SheetExists(SheetName As String, wb As Workbook)
    On Error Resume Next
    SheetExists = Not wb.Sheets(SheetName) Is Nothing
End Function

Upvotes: 1

Related Questions