Excel VBA批量提取XML文件AK列数据到目标工作表报错如何解决

• 整列复制导致行溢出：你直接复制AK:AK整列（Excel共1048576行），粘贴起点是目标表的xCount行，剩余可用行数不足1048576行，触发索引越界错误。
• 变量未定义/引用错误：第一个版本中只定义了desiredSheetName字符串变量，后续调用desiredSheet.UsedRange时，desiredSheet工作表对象未声明赋值，直接报错。
• 工作表归属不明确：硬编码Worksheets("Feuil2")时，默认指向当前激活的工作簿，而你刚打开XML文件时，激活工作簿是刚打开的XML工作簿，其中不存在Feuil2工作表，因此提示索引不属于选择范围。
• 粘贴位置逻辑错误：你获取的xCount是目标表已有数据的最后一行行号，直接粘贴到该位置会覆盖原有最后一行数据，应该偏移1行作为粘贴起点。

Dim targetSht As Worksheet
' 先绑定目标工作表到当前运行代码的工作簿，避免激活状态影响
Set targetSht = ThisWorkbook.Worksheets("Feuil2") 

Dim xFile As String
xFile = Dir(xStrPath & "\*.xml")

Do While xFile <> ""
    Dim xWb As Workbook
    Set xWb = Workbooks.OpenXML(xStrPath & "\" & xFile)
    Dim sourceSht As Worksheet
    Set sourceSht = xWb.Sheets(1)
    
    ' 只复制源表AK列有数据的区域，不复制整列
    Dim sourceRng As Range
    Set sourceRng = sourceSht.Range("AK1:AK" & sourceSht.Cells(sourceSht.Rows.Count, "AK").End(xlUp).Row)
    
    ' 计算目标表下一个空行位置
    Dim xCount As Long
    xCount = targetSht.Cells(targetSht.Rows.Count, 1).End(xlUp).Row + 1
    
    ' 直接赋值比拷贝粘贴效率更高，避免剪贴板操作问题
    targetSht.Range("A" & xCount).Resize(sourceRng.Rows.Count, 1).Value = sourceRng.Value
    
    xWb.Close SaveChanges:=False
    xFile = Dir()
Loop

如果要恢复选择目标表的交互逻辑，把Set targetSht = ThisWorkbook.Worksheets("Feuil2")替换为以下代码即可：

Dim selectRng As Range
On Error Resume Next ' 处理用户点取消的情况
Set selectRng = Application.InputBox("Select any cell inside the target sheet: ", "Prompt for selecting target sheet name", Type:=8)
On Error GoTo 0
If selectRng Is Nothing Then Exit Sub ' 用户取消则退出程序
Set targetSht = selectRng.Worksheet

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