VBA复制筛选区域时设置Range报Type mismatch错误求解

两个报错都是Range对象构造时的语法错误导致：

• 类型不匹配错误：VBA中And是逻辑/按位运算符，仅支持布尔值、数值类型的运算。你写的"E2:L" And lRow1是将字符串类型的地址片段和长整型的行号直接做逻辑运算，两个类型无法兼容，直接触发类型不匹配，代码根本没有进入Range地址解析的流程。
• 应用定义/对象定义错误：Range()方法要求传入完整合法的单元格地址字符串，"E2:L"缺少结束行号，属于无效地址，Excel无法识别对应的区域范围，因此抛出错误。

VBA中拼接字符串需要用&连接符，你要构造E2到L列最后一行的区域，正确代码为：

Set rng1 = ws2.Range("E2:L" & lRow1)

你的代码里还有几个容易触发运行错误的隐患，需要一并调整：

• VBA变量声明规则为每个变量单独指定类型，你当前的写法Dim SavePath, TemplatePath, TemplateFile As String中，前两个变量默认是Variant类型而非String；同理Dim ws1, ws2, ws3, wbws1, wbws2, wbws3 As Worksheet、Dim rng1, rng2 As Range也存在同样问题，未单独指定类型的变量都会默认是Variant，容易引发意外问题。
• 筛选后如果当前国家没有匹配数据，lRow1会返回表头行的行号1，此时构造的E2:L1是无效区域，直接赋值会报错，需要加判断跳过无数据的国家。
• 开启筛选后如果不指定可见单元格，直接取值会把筛选隐藏的行数据也一并复制，不符合筛选复制的需求，需要通过SpecialCells(xlCellTypeVisible)指定仅取可见区域。
• 目标区域rng2不需要手动计算结束行号，模板表初始为空时你计算的lRow2是无效值，直接以目标起始单元格为原点，用Resize方法匹配源区域的行列数即可，能保证两个区域大小完全一致，不会出现数据截断或溢出。
• Rows.Count前需要加工作表限定，避免活动工作表不是目标表时，取错不同版本Excel的最大行数（兼容模式工作表最大行数为65536，新版为1048576）。
• 你定义了TemplateFile变量存储模板文件名，打开工作簿时直接引用变量即可，不需要硬编码文件名，后续修改模板路径/名称时只需要改一处。

Sub CopyData_To_TemplateWorkbook2()

Dim wb As Workbook
Dim SavePath As String, TemplatePath As String, TemplateFile As String
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim wbws1 As Worksheet, wbws2 As Worksheet, wbws3 As Worksheet
Dim rng1 As Range, rng2 As Range
Dim MSi As String
Dim lRow1 As Long, lRow2 As Long
Dim i As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False

TemplatePath = "C:\Users\xyz\Test\"
TemplateFile = "Template_blank.xlsx"
SavePath = "C:\Users\xyz\Test\"

Set ws1 = ThisWorkbook.Sheets("Lists")
Set ws2 = ThisWorkbook.Sheets("Responses 2006 2020")

For i = 2 To 5 'Loop through list of country names
    MSi = ws1.Range("A" & i).Value

    If ws2.FilterMode Then
        ws2.ShowAllData
    End If
    ws2.Range("B1").AutoFilter Field:=2, Criteria1:=MSi
    
    lRow1 = ws2.Range("E" & ws2.Rows.Count).End(xlUp).Row
    ' 无匹配数据直接跳过当前循环
    If lRow1 < 2 Then GoTo NextLoop
    
    ' 构造筛选后可见数据区域
    Set rng1 = ws2.Range("E2:L" & lRow1).SpecialCells(xlCellTypeVisible)

    Set wb = Workbooks.Open(Filename:=TemplatePath & TemplateFile, Editable:=True)
    Set wbws1 = wb.Sheets("Cover sheet")
    Set wbws2 = wb.Sheets("Responses")

    wbws1.Range("B2").Value = MSi
    wbws2.Range("B2").Value = MSi
      
    ' 自动匹配源区域大小构造目标区域
    Set rng2 = wbws2.Range("A6").Resize(rng1.Rows.Count, rng1.Columns.Count)
    rng2.Value = rng1.Value
    
    wb.SaveAs Filename:=SavePath _
        & MSi & "_text" & Format(Date, "yyyymmdd") & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    
    wb.Close SaveChanges:=False

    Set rng1 = Nothing
    Set rng2 = Nothing
NextLoop:
Next i

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

内容的提问来源于stack exchange，提问作者cdfj