Dropdownlist loop copy paste

[rizabdullah]

Hi Guys

I am a beginner with vb and wondering if somebody can help.

I have source workbook with dropdowllist in B3 sheet name "Front Sheet", the list is based on data from another sheet in same workbook. I also have destination macro-enabled workbook "Combined", from here I like to run my vb.

What I am trying to achieve is to be able to loop through the DDL in source file front sheet, read the first code from DDL set that as range, update the data (data range B1:K50) in front sheet, copy this range and paste it to the Combined workbook on new sheet fronm A1 and rename this new sheet as the value from the source file Front Sheet B3 value.

I have managed the below below which runs, HOWEVER, it seems like its not changing the code in B3 hence not updating the range on Front Sheet workbook. Please can someone help:

Sub mytset()

Dim SourceWB As Workbook, DestWB As Workbook
Dim SourceSht As Worksheet, DestSht As Worksheet
Dim c As Range, myListRng As Range
Dim myListStr As String, myShtStr As String, myRngStr As String

' Initial
Set SourceWB = Workbooks("Refurbs Tracker") ' <~~ Use your Source Workbook name - "Refurbs Tracker" ?
Set DestWB = Workbooks("Combined") ' <~~ Use your Destination Workbook name - "Combined" ?
Set SourceSht = SourceWB.Worksheets("Front Sheet") ' <~~ Use your Source Sheet name - "Front Sheet" ?

' find the drop down values
If SourceSht.Range("B3").Validation.Type = xlValidateList Then
myListStr = Mid(SourceSht.Range("B3").Validation.Formula1, 2)
On Error Resume Next
Set myListRng = SourceWB.Names(myListStr).RefersToRange
If Err.Number <> 0 Then
myShtStr = Left(myListStr, InStr(1, myListStr, "!") - 1)
myRngStr = Right(myListStr, Len(myListStr) - Len(myShtStr) - 1)
myShtStr = Replace(myShtStr, "'", "")
Set myListRng = SourceWB.Worksheets(myShtStr).Range(myRngStr)
End If
On Error GoTo 0
Else
MsgBox "Problem with Validation List"
Exit Sub
End If

' loop through the drop down values and do work
For Each c In myListRng
If SheetExists(c.Value, DestWB) Then
Set DestSht = DestWB.Worksheets(c.Value)
Else
Set DestSht = DestWB.Worksheets.Add
DestSht.Name = c.Value
End If
SourceSht.Range("B1:K50").Copy
DestSht.Range("A1").PasteSpecial PASTE:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Next c
Application.CutCopyMode = False

' Clean up
Set SourceSht = Nothing
Set DestSht = Nothing
Set SourceWB = Nothing
Set DestWB = Nothing

End Sub




Function SheetExists(Name As String, WB As Workbook) As Boolean
Dim WS As Worksheet
SheetExists = False
For Each WS In WB.Worksheets
If Name = WS.Name Then
SheetExists = True
GoTo CleanUp:
End If
Next WS
CleanUp:
Set WS = Nothing
End Function