Open file-Copy data from and XLSX to xls document

Try:

Sub GetZip()
    Const sSrcFileName As String = "C:\Test\Data\Zip to county to Region.xlsx" 'Source filename (full path)
    Const sWSName As String = "Zip to Region" 'Source worksheet name
    Const bCloseSRC As Boolean = False 'change to True to close the source file after copying data
    
    Dim wbSrc As Workbook
    Dim wbTgt As Workbook
    Dim ws As Worksheet
    
    On Error GoTo Terminate
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Set wbTgt = ThisWorkbook
    
    If WSExists(wbTgt, sWSName) Then
        If MsgBox("Worksheet " & sWSName & " already exists. Replace contents?", vbQuestion + vbYesNo) = vbNo Then
            GoTo Terminate
        Else
            Set ws = wbTgt.Worksheets(sWSName)
            ws.UsedRange.Clear
        End If
    Else
        With wbTgt
            Set ws = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            ws.Name = sWSName
        End With
    End If
    
    Set wbSrc = Workbooks.Open(sSrcFileName)
    If wbSrc Is Nothing Then
        Err.Raise -1001, , "Unable to open source workbook"
    Else
        wbSrc.Worksheets(sWSName).UsedRange.Copy ws.Range("A1")
    End If
    
    If bCloseSRC Then wbSrc.Close savechanges:=False
    
Terminate:
    If Err Then
        MsgBox "Error " & Err.Number & " - " & Err.Description, vbCritical + vbOKOnly
        Err.Clear
    End If
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Function WSExists(ByRef wb As Workbook, ByRef sSheetName As String) As Boolean
    Dim ws As Worksheet
    For Each ws In wb.Worksheets
        If ws.Name = sSheetName Then WSExists = True
    Next ws
End Function

Originally Posted by 3345james

Opens the workbook but doesn't copy data to open workbook named
like "Excessive*.xls"

Are you putting (and running) the code in the "Excessive*" workbook, or in another workbook?

If it's in another workbook, then we need to change this line:

    Set wbTgt = ThisWorkbook

You said the workbook is "named like Excessive*.xls"

So try changing the code to:

Sub GetZip()
    Const sSrcFileName As String = "C:\Test\Data\Zip to county to Region.xlsx" 'Source filename (full path)
    Const sTgtFileNameContains As String = "Excessive"
    Const sWSName As String = "Zip to Region" 'Source worksheet name
    Const bCloseSRC As Boolean = False 'change to True to close the source file after copying data
    
    Dim wbSrc As Workbook
    Dim wbTgt As Workbook
    Dim ws As Worksheet
    
    On Error GoTo Terminate
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Set wbTgt = TargetWB(sTgtFileNameContains)
    If wbTgt Is Nothing Then Err.Raise -1002, , "No open workbook named '*" & sTgtFileNameContains & "'*"
    
    If WSExists(wbTgt, sWSName) Then
        If MsgBox("Worksheet " & sWSName & " already exists. Replace contents?", vbQuestion + vbYesNo) = vbNo Then
            GoTo Terminate
        Else
            Set ws = wbTgt.Worksheets(sWSName)
            ws.UsedRange.Clear
        End If
    Else
        With wbTgt
            Set ws = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            ws.Name = sWSName
        End With
    End If
    
    Set wbSrc = Workbooks.Open(sSrcFileName)
    If wbSrc Is Nothing Then
        Err.Raise -1001, , "Unable to open source workbook"
    Else
        wbSrc.Worksheets(sWSName).UsedRange.Copy ws.Range("A1")
    End If
    
    If bCloseSRC Then wbSrc.Close savechanges:=False
    
Terminate:
    If Err Then
        MsgBox "Error " & Err.Number & " - " & Err.Description, vbCritical + vbOKOnly
        Err.Clear
    End If
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Function WSExists(ByRef wb As Workbook, ByRef sSheetName As String) As Boolean
    Dim ws As Worksheet
    For Each ws In wb.Worksheets
        If ws.Name = sSheetName Then WSExists = True
    Next ws
End Function

Public Function TargetWB(ByVal sName As String) As Workbook
    Dim wb As Workbook
    For Each wb In Application.Workbooks
        If InStr(wb.Name, sName) > 0 And wb.FileFormat = 56 Then Set TargetWB = wb
    Next wb
End Function

I've highlighted the changes in red.

Hopefully, Olly's suggestion works for you.
But here is a way to auto-convert your xlsx file to xls
ChosenName does not require an extension.
Amend myPath and myFile to match your requirements


1. put code below in a general module in a workbook
2. open file "Zip to county to Region.xlsx"
3. run the code

Sub SaveWorkBookAsXLX()
    Dim myPath As String, myFile As String, zFile As String
    
    zFile = "Zip to county to Region.xlsx"
    myPath = ActiveWorkbook.Path & "\"      'must finish path with trailing "\"
    myFile = "ChosenName"
    Application.Windows(zFile).Activate
    ActiveWorkbook.SaveAs Filename:=myPath & myFile, FileFormat:=xlExcel8
End Sub

No attachment?