我有这个 Excel VBA 代码，它可以完美运行并且完全执行其应有的操作，直到这一行：
csvSheet.Range("B5").Resize(colBValues.Rows.Count, 1).PasteSpecial Paste:=xlPasteValues
此代码需要从其他工作表的表格中获取数据，将其放入ManualJournal工作表中，然后将该ManualJournal工作表保存为单独的.csv文件。它确实这样做了，但是当复制日期列时，日期的格式会发生变化，这意味着 9 月 1 日更改为 1 月 9 日。问题是这个 csv 文件需要导入到 Xero，但错误的日期会导致错误的数据。
现在的问题是，使用 PasteSpecial 方法，它很好地复制了日期，并且所有数据都很完美，但它仍然给我一个错误，并且不执行该行之后的指令。 收到错误消息
生成运行时 1004 错误，表示 Range 类的 PasteSpecial 方法失败
Sub CSVDateFormat()
' Define variables
Dim ws As Worksheet
Dim tbl As ListObject
Dim destWorksheet As Worksheet
Dim lastRow As Long
Dim tableData As Range
Dim startString As String
Dim destSheetName As String
Dim rowCount As Long
Dim amountCol As Range
Dim sumAmount As Double
Dim amountColNumber As Long
Dim amountHeader As String
Dim savePath As String
Dim fileName As String
Dim baseFileName As String
Dim dateInA1 As String ' New variable for the date in A1
Dim csvFilePath As String
Dim csvWorkbook As Workbook
Dim cell As Range
Dim rng As Range
Dim colBValues As Range ' New variable for column B values
Dim csvSheet As Worksheet ' New variable for the CSV sheet
' Set the string that worksheet names should start with
startString = "Amort" ' Prefix for the worksheets to copy from
' Set the destination worksheet name
destSheetName = "ManualJournal" ' Destination worksheet
' Set the amount column header name (change to match your column header)
amountHeader = "*Amount" ' Change this if the "Amount" column has a different name
' Set the destination worksheet in the same workbook
Set destWorksheet = ThisWorkbook.Sheets(destSheetName)
' Initialize the last row to start pasting data (start from row 5)
lastRow = 5
' Loop through each worksheet in the active workbook
For Each ws In ThisWorkbook.Worksheets
' Check if the sheet name starts with the specified string
If Left(ws.Name, Len(startString)) = startString Then
' Check if the worksheet contains any tables
If ws.ListObjects.Count > 0 Then
' Loop through all tables on the worksheet
For Each tbl In ws.ListObjects
' Get the table data excluding headers
Set tableData = tbl.DataBodyRange
' Only proceed if the table has data
If Not tableData Is Nothing Then
' Get the number of rows in the table to be copied
rowCount = tableData.Rows.Count
' Find the next available row on the destination sheet (after last used row)
If lastRow = 5 Then
' If it's the first entry, paste starting at row 5
tableData.Copy
destWorksheet.Cells(lastRow, 1).PasteSpecial Paste:=xlPasteValues
' Update lastRow to reflect the newly pasted data
lastRow = lastRow + rowCount
Else
' Otherwise, paste after the last row
lastRow = destWorksheet.Cells(destWorksheet.Rows.Count, 1).End(xlUp).Row + 1
tableData.Copy
destWorksheet.Cells(lastRow, 1).PasteSpecial Paste:=xlPasteValues
' Update lastRow to reflect the newly pasted data
lastRow = lastRow + rowCount
End If
End If
Next tbl
End If
End If
Next ws
' Find the "Amount" column in the destination sheet
On Error Resume Next
amountColNumber = Application.WorksheetFunction.Match(amountHeader, destWorksheet.Rows(4), 0)
On Error GoTo 0
' Check if the "Amount" column was found
If amountColNumber > 0 Then
' Sum the "Amount" column starting from row 5 to the last row with data
Set amountCol = destWorksheet.Range(destWorksheet.Cells(5, amountColNumber), _
destWorksheet.Cells(lastRow - 1, amountColNumber))
sumAmount = Application.WorksheetFunction.Sum(amountCol)
Else
MsgBox "Error: 'Amount' column not found in the ManualJournal sheet.", vbCritical
End If
' Convert Column B in the ManualJournal sheet to text format
Set rng = destWorksheet.Range("B5:B" & lastRow - 1)
For Each cell In rng
' If the cell contains a date, format it as "yyyy/MM/dd" and force it to be text
If IsDate(cell.Value) Then
cell.Value = "'" & Format(cell.Value, "yyyy/MM/dd")
Else
' Convert any other value to text
cell.Value = "'" & cell.Value
End If
Next cell
' Get the date from cell A1 in "ManualJournal" and format it
dateInA1 = Format(destWorksheet.Range("A1").Value, "yyyy-mm-dd") ' Ensures the date is formatted correctly for filenames
' Set the active worksheet (the one where the button is placed)
Set ws = ActiveSheet
' Define the save path
savePath = ThisWorkbook.Path ' This saves in the same directory as the current workbook
' Get the base file name of the current workbook without the extension
baseFileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
' Define the file name using the workbook's base name and the date from A1
fileName = baseFileName & " - Manual Journal - " & dateInA1 & ".csv"
' Save the active sheet as a csv file (.csv)
ws.Copy ' Creates a new workbook with only the active sheet
ActiveWorkbook.SaveAs fileName:=savePath & "\" & fileName, FileFormat:=xlCSV
' Close the newly saved workbook
ActiveWorkbook.Close SaveChanges:=False
' Pause briefly to ensure the file is saved completely
Application.Wait (Now + TimeValue("0:00:01")) ' Pause for 2 seconds
' Define the full path to the saved CSV file
csvFilePath = savePath & "\" & fileName
' Open the saved CSV file
Set csvWorkbook = Workbooks.Open(csvFilePath)
Set csvSheet = csvWorkbook.Sheets(1) ' Reference the CSV sheet
' Copy column B from the ManualJournal sheet
Set colBValues = destWorksheet.Range("B5:B" & lastRow - 1)
' Check if there are any values to copy
If Application.WorksheetFunction.CountA(colBValues) > 0 Then
'Paste column B values into column B of the CSV sheet starting from cell B5 (to preserve headers)
csvSheet.Range("B5").Resize(colBValues.Rows.Count, 1).PasteSpecial Paste:=xlPasteValues
End If
' Delete the first 3 rows (adjust this as needed)
csvSheet.Rows("1:3").Delete Shift:=xlUp
' Ensure data is in Column A
csvSheet.Columns("A:A").Select
' Convert text to columns using commas as the delimiter
csvSheet.Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False
' Save and close the workbook
csvWorkbook.Save
csvWorkbook.Close SaveChanges:=False
End Sub
我尝试使用 ChatGPT 来解决这个问题，但是在按照 AI 建议以及我认为可能是错误的内容更改代码后，其他日期列仍然没有显示应有的数据，或者代码根本不运行。我不确定从这里该去哪里。
在再次使用代码后，我明确添加了复制命令，并添加了在将数据粘贴到 csv 文件后清除剪贴板的命令。这确实解决了问题。数据文本已正确粘贴，而不是采用日期格式，因为 .csv 文件会更改日期本身。现在它被粘贴为文本，它可以 100% 工作。