Copy/Paste 日期格式到另一个工作簿中 WS 的列

Question

我正在使用来自两个不同来源的数据。每个来源的 date/time 格式都不同。我需要将两组数据放入一个工作表中并删除重复项。日期格式差异阻止了这种情况。我正在尝试将日期格式从工作簿 "A" 复制到工作簿 "B" 中现有数据的列范围，以便当我将数据从工作簿 "A" 复制到工作簿的末尾时 "B"，日期格式将匹配。

工作簿"A"中的日期格式是：

工作簿 "B" 中的日期格式为：

我在下面提供了完整的代码。但这是我添加的行：

sourceWorksheet.Range("G2").Copy destinationWorksheet.Range("G2:H2000").PasteSpecial(xlPasteFormats, Operation:=xlNone, SkipBlanks:=False)

这给了我以下错误：

运行-时间错误'1004'：无法获取范围 class

的 PasteSpecial 属性

这里是整个代码集：

Sub QA_1603_March()
'
    Dim ANS As Long
    Dim LR As Long
    Dim uRng As Range
    Dim she As Worksheet

    ANS = MsgBox("Is the March 2016 Swivel Master File checked out of SharePoint and currently open on this desktop?", vbYesNo + vbQuestion + vbDefaultButton1, "Master File Open")
    If ANS = vbNo Or IsWBOpen("Swivel - Master - March 2016") = False Then
        MsgBox "The required workbook is not currently open. This procedure will now terminate.", vbOKOnly + vbExclamation, "Terminate Procedure"
        Exit Sub
    End If

    Call Verification_Format_WS

    Dim sourceWorkBook As Workbook
        Set sourceWorkBook = Workbooks("Verification Temp.xlsx")
    Dim destinationWorkbook As Workbook
        Set destinationWorkbook = Workbooks("Swivel - Master - March 2016.xlsm")
    Dim sourceWorksheet As Worksheet
        Set sourceWorksheet = sourceWorkBook.Sheets("Verification")
    Dim destinationWorksheet As Worksheet
        Set destinationWorksheet = destinationWorkbook.Sheets("Validation")

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    sourceWorksheet.Cells.EntireRow.Hidden = False

    sourceWorksheet.Range("G2").Copy destinationWorksheet.Range("G2:H2000").PasteSpecial(xlPasteFormats, Operation:=xlNone, SkipBlanks:=False)

    For LR = sourceWorksheet.Range("J" & Rows.Count).End(xlUp).row To 2 Step -1
        If sourceWorksheet.Range("J" & LR).Value <> "3" Then
            If uRng Is Nothing Then
                Set uRng = sourceWorksheet.Rows(LR)
            Else
                Set uRng = Union(uRng, sourceWorksheet.Rows(LR))
            End If
        End If
    Next LR

    If Not uRng Is Nothing Then uRng.Delete
        For Each she In destinationWorkbook.Worksheets
        If she.FilterMode Then she.ShowAllData
    Next

    With sourceWorksheet.Sort
        With .SortFields
            .Clear
            .Add Key:=Range("A2:A2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("G2:G2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("B2:B2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("C2:C2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("D2:D2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("E2:E2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End With
        .SetRange Range("A2:AE2000")
        .Apply
    End With

    sourceWorksheet.Cells.WrapText = False

    Dim lastRow As Long
    lastRow = sourceWorksheet.Range("A" & Rows.Count).End(xlUp).row
    Dim destinationRow As Long
    destinationRow = destinationWorksheet.Cells(Rows.Count, 1).End(xlUp).row + 1
    sourceWorksheet.Range("A2:J" & lastRow).Copy destinationWorksheet.Range("A" & destinationRow)

    Call Verification_Save
    Call Verification_Delete_Temp_Workbook

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

End Sub

我已经根据我在此处找到的示例尝试了一些变体，但我总是遇到这样或那样的错误。

Answer 1

问题在于线路：

sourceWorksheet.Range("G2").Copy destinationWorksheet.Range("G2:H2000").PasteSpecial(xlPasteFormats, Operation:=xlNone, SkipBlanks:=False)

语法无效。

Copy 方法有一个可选参数，用于将 Range 对象作为目标传递。通过将 PasteSpecial 方法添加到范围，这将不再有效。

试试这个：

sourceWorksheet.Range("G2").Copy 
destinationWorksheet.Range("G2:H2000").PasteSpecial(xlPasteFormats, Operation:=xlNone, SkipBlanks:=False)

Answer 2

正如@Scott 所说，复制行需要分成两行。但是，您不需要 Operation:=xlNone, SkipBlanks:=False 部分，因为默认情况下它们将被设置为该部分。以下应该工作。

sourceWorksheet.Range("G2").Copy
destinationWorksheet.Range("G2:H2000").PasteSpecial xlPasteFormats

*注意：在这种情况下，您不需要括号来传递参数。

Copy/Paste 日期格式到另一个工作簿中 WS 的列

Copy/Paste Date format into a column on a WS in another workbook

excel

vba

date-formatting