Excel VBA选择可变范围非空单元格导出时出现运行时错误'13'（类型不匹配）的问题求助

嗨，我来帮你捋捋这个问题哈～你遇到的类型不匹配错误，核心原因和代码里的几个小问题有关，我一步步给你拆解：

首先说报错的直接原因：你的Find方法参数设置有问题，而且没处理“找不到非空单元格”的情况。如果D列全是空的，Find会返回Nothing，这时候你再去调用lastVal.Address就直接触发类型不匹配错误了。另外代码里还有几个不符合你需求的细节，我一起给你修正：

原代码的核心问题 #

1. Find起始位置错误：你用sht.Cells(1, 48)（第1行第48列）作为查找起始点，这和你要找的D列（第4列）完全不相关，会导致查找逻辑混乱。
2. 未处理无匹配的情况：如果D列没有任何数据，lastVal会变成Nothing，后续引用它的属性就会报错。
3. Resize列数不符合需求：你要选的是C-J列（共8列），但Resize(,48)会把范围拉到第48列，明显和你的需求不符。
4. 复制粘贴写法不严谨：用Select+Selection.Copy容易受当前选中状态影响，稳定性差。

修改后的可运行代码 #

Dim lastVal As Range, sht As Worksheet
Dim newWB As Workbook

' 绑定当前工作簿的sheet1
Set sht = ThisWorkbook.Sheets("sheet1")

' 在D列从下往上查找最后一个非空单元格，起始点设为D列最后一行
Set lastVal = sht.Columns(4).Find(What:="*", _
                                After:=sht.Cells(sht.Rows.Count, 4), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious)

' 先判断是否找到有效数据
If Not lastVal Is Nothing Then
    ' 直接复制C2到对应行的J列范围
    sht.Range("C2", sht.Cells(lastVal.Row, "J")).Copy
    
    ' 创建新工作簿并粘贴数据
    Set newWB = Workbooks.Add
    ' 按需选择粘贴类型，这里是粘贴值和格式
    newWB.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False ' 清除剪贴板，释放资源
Else
    MsgBox "D列没有找到非空数据哦！"
End If

关键修改说明 #

• 调整Find的起始位置为D列最后一行，确保能精准定位到最后一个非空单元格
• 增加If Not lastVal Is Nothing判断，避免无数据时报错
• 直接定位到J列代替Resize(,48)，完全匹配你C-J列的需求
• 去掉Select操作，直接操作指定范围，代码更稳定
• 明确新工作簿的工作表，指定粘贴类型，同时清除剪贴板避免残留

你可以试试这段代码，应该就能顺利完成数据导出啦～

备注：内容来源于stack exchange，提问作者Frederick Egan