Copy a Worksheet if the Cell Value equals a certain string using row and column indexes - excel

Question

The purpose of this is to find the column who has the header "Type Test" and loop through that column, in this case B to find all unique value cells. If the string in column B is unique and does not replace, I need it to make a copy of the worksheet whose name matches the trial name in column A. So for Test 1 who has a row index of 3 and a column index of 2, will make a copy of the worksheet in the current workbook called "DEF" and rename the copy to be "Test 1"
For example here is my data
A B
Trial Type_Test
DEF Test 1
ABC Test 3
ABC Test 10
DEF Test 14
ABC Test 10
However, I dont want to make a copy of the sheet ABC if the column B values repeat for column A, so since rows 3 and 5 are the same, I only want to make copies of ABC sheet twice, once for row 2 and once for row 3. Row 5 can be ignored since it is the same as row 3.
I have written a code that does the first part regarding make a sheet and renaming it, I just cant get the copy the other worksheet part.
Public Sub Main()
Dim srtsht As Variant, sysnum As Variant, arr As Variant, partnum As Variant
Dim wsh As Worksheet
srtsht = Sheets("Sheet1").Range("E2:E15")
With CreateObject("scripting.dictionary") ' store data in array where each item is associated with a unique key
For Each sysnum In srtsht
arr = .Item(sysnum)
Next sysnum
For Each value In .Keys
On Error Resume Next
If value <> "" Then
Set wsh = Nothing ' clear the variable wsh
Set wsh = Worksheets(CStr(value)) ' try to set wsh to the sheet with Value as name
On Error GoTo 0
If wsh Is Nothing Then
Call position
If Worksheets("Sheet1").Cells(A_row,A_col).Value = "ABC" Then
Worksheets("ABC").Copy After:=ActiveSheet
wsh = Worksheets("Sheet1").Cells(A_row,A_col).Values
Worksheets("ABC (2)").name = wsh
wsh.name = CStr(Value)
End If
Else
MsgBox "Sheet" & Values & "already exists.", vbInformation
End If
End If
Next Value
End With
End Sub
Sub position ()
Dim syswaivernum As Range, partnumber As Range
For Each syswaivernum In Worksheets("Sheet1").Range("A1:Z20")
If syswaivernum.value = "Number(s)" Then
sysnumcol = syswaivernum.Column
sysnumrow = syswaivernum.Row
End If
Next syswaivernum
For Each partnumber In Worksheets("Sheet1").Range("A1:Z20")
If partnumber.value = "Part" Then
A_col = partnumber.Column
A_row = partnumber.Row
End If
Next partnumber
End Sub

Answer 1

Try this - see comments inline:
Public Sub Main()
Dim wb As Workbook, tst As String, wsName As String
Dim c As Range, ws As Worksheet, dict As Object
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1")
Set dict = CreateObject("scripting.dictionary")
For Each c In ws.Range("E2:E15").Cells
tst = c.Value
If Not dict.exists(tst) Then 'first time seeing this value?
dict.Add tst, True '###
If Not SheetExists(tst) Then
wsName = c.EntireRow.Columns("A").Value 'sheet to be copied
If SheetExists(wsName) Then 'if there's a sheet for wsName
wb.Worksheets(wsName).Copy After:=ws 'copy the sheet
wb.Worksheets(ws.Index + 1).Name = tst '### rename the copy
End If
Else
MsgBox "Sheet '" & wsName & "' already exists"
End If
End If
Next c
End Sub
'Does a sheet named `SheetName` exist?
' Defaults to checking `ThisWorkbook` if `wb` is not specified
Function SheetExists(SheetName As String, _
Optional wb As Excel.Workbook) As Boolean
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
SheetExists = Not wb.Sheets(SheetName) Is Nothing
End Function