I'm running into a little trouble with this code. I have commented the trouble spot.
Cell "B4" would be populated from an input box.
The variations in "B4" could be up to 8, but may be as few as 1.

Sub Import_Files()

Dim ws As Worksheet
Dim ws1 As Worksheet
Dim a, path1, zz, zzz As String
Set ws1 = Worksheets("Lists")
Set xl = CreateObject("Excel.Sheet")

Application.ScreenUpdating = False
path1 = ws1.Range("C4").Value
a = ws1.Range("B4").Value

do_over:
CurrentFileName = Dir(path1 & "\" & a & "*.xls")

Do
'check for file name - delete if not current size listed in cell B4 on Lists sheet
zz = Left(CurrentFileName, 4)
zzz = ws1.Range("B4").Value
If zz <> zzz Then GoTo skiptohere

  xl.Application.Workbooks.Open path1 & "\" & CurrentFileName
  Sheets().Move after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  CurrentFileName = Dir()
  
skiptohere:
Loop While CurrentFileName <> ""

'**********************************************************************
' Here is where I run into trouble.
' Cell "B4" would be like "W40X". (This is a file name "W40X210.xls")
' I need to also include workbooks named "WB40X", or "WS40X", etc.
' The file name could be up to 8 variations

If dd = 1 Then GoTo put_them
cc = Left(a, 1)
If cc = "W" Then
  ee = "WB" & Right(a, 3)
  a = ee
  dd = 1
End If

If dd = 1 Then GoTo do_over
'**********************************************************************

put_them:
dd = 0
'Put each sheet rollweek in column "D" next to sheet name
b = ws1.Range("D5").Value
For a = 6 To b
  myname = ws1.Range("C" & a).Value
  Set ws2 = Worksheets(myname)
  ws1.Range("D" & a).Value = ws2.Range("B5").Value
Next a
End Sub
Thanks