Excel VBA PasteSpecial方法运行报错：功能正常但后续代码无法执行

核心问题分析 #

1. 日期格式错乱：Excel日期本质是序列号，复制或保存为CSV时会因系统区域设置自动转换格式（如dd/mm/yyyy被识别为mm/dd/yyyy）。
2. PasteSpecial 1004错误：依赖剪贴板的复制粘贴操作易受剪贴板状态、区域尺寸不匹配等因素影响，稳定性差。

解决方案：替换复制粘贴为直接值赋值+日期格式化 #

以下是修正后的代码，通过直接赋值避免剪贴板依赖，并将日期转换为无歧义的ISO格式（yyyy-mm-dd）确保CSV保存后格式正确：

Sub ExportAmortToCSV()
    Dim ws As Worksheet
    Dim targetWs As Worksheet
    Dim lastRow As Long
    Dim targetLastRow As Long
    Dim dateCol As Integer
    Dim i As Long
    
    ' 定位目标工作表
    On Error Resume Next
    Set targetWs = ThisWorkbook.Worksheets("ManualJournal")
    On Error GoTo 0
    If targetWs Is Nothing Then
        MsgBox "未找到ManualJournal工作表！", vbExclamation
        Exit Sub
    End If
    
    ' 清空目标表原有数据（按需保留或删除）
    targetWs.Cells.Clear
    
    ' 遍历所有以"Amort"开头的工作表
    For Each ws In ThisWorkbook.Worksheets
        If Left(ws.Name, 5) = "Amort" Then
            ' 获取源表最后一行数据
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            
            If lastRow >= 1 Then
                ' 确定目标表起始粘贴行（从第5行开始）
                targetLastRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row
                If targetLastRow < 5 Then targetLastRow = 4
                
                ' 直接赋值非日期列（避免剪贴板操作）
                targetWs.Range("A" & targetLastRow + 1).Resize(lastRow, 1).Value = ws.Range("A1:A" & lastRow).Value
                targetWs.Range("C" & targetLastRow + 1).Resize(lastRow, 1).Value = ws.Range("C1:C" & lastRow).Value
                
                ' 处理日期列（转换为ISO格式字符串）
                dateCol = 2 ' 假设日期在B列，按需调整
                For i = 1 To lastRow
                    If IsDate(ws.Cells(i, dateCol).Value) Then
                        ' 设置目标单元格为文本格式，写入yyyy-mm-dd格式日期
                        targetWs.Cells(targetLastRow + i, dateCol).NumberFormat = "@"
                        targetWs.Cells(targetLastRow + i, dateCol).Value = Format(ws.Cells(i, dateCol).Value, "yyyy-mm-dd")
                    Else
                        ' 非日期值直接复制
                        targetWs.Cells(targetLastRow + i, dateCol).Value = ws.Cells(i, dateCol).Value
                    End If
                Next i
            End If
        End If
    Next ws
    
    ' 保存为CSV文件
    Dim savePath As String
    savePath = ThisWorkbook.Path & "\ManualJournal.csv"
    
    ' 方式1：使用SaveAs（简单直接，依赖单元格格式）
    targetWs.SaveAs Filename:=savePath, FileFormat:=xlCSV, Local:=True
    
    ' 方式2：手动写入CSV（完全控制格式，避免Excel自动转换）
    ' 如需更精准控制，可取消注释以下代码替换上述SaveAs
    ' Dim fso As Object, ts As Object
    ' Dim row As Range, cell As Range, csvLine As String
    ' Set fso = CreateObject("Scripting.FileSystemObject")
    ' Set ts = fso.CreateTextFile(savePath, True, True)
    ' For Each row In targetWs.UsedRange.Rows
    '     csvLine = ""
    '     For Each cell In row.Cells
    '         csvLine = csvLine & IIf(InStr(cell.Value, ","), """" & Replace(cell.Value, """", """""") & """", cell.Value) & ","
    '     Next cell
    '     ts.WriteLine Left(csvLine, Len(csvLine) - 1)
    ' Next row
    ' ts.Close
    
    MsgBox "CSV文件已保存至：" & savePath, vbInformation
End Sub

关键修复点 #

1. 替换PasteSpecial：用Range.Value = Range.Value直接赋值，彻底避免剪贴板相关的1004错误，同时提升运行效率。
2. 日期格式标准化：将日期转换为yyyy-mm-dd格式的文本，确保CSV文件中的日期不会因区域设置被错误解析。
3. 双CSV保存方式：
   • 简单场景用SaveAs即可满足需求；
   • 复杂数据（含逗号、特殊字符）推荐手动写入CSV，确保数据完全按预期保存。

内容的提问来源于stack exchange，提问作者LL-CloaXy