在循环中将格式从一个范围粘贴到另一个范围

时间:2017-06-21 16:31:47

标签: excel vba format

我正在使用以下代码来比较两个工作表。如果第二个工作表中不存在记录,我会将第一个工作表中的某些列复制到第二个工作表。

我遇到的问题是我需要在Sheet2中的新行上格式化以匹配工作表其余部分的格式。我在“新代码”注释块之间添加了代码,但我不断收到错误消息:运行时错误'1004':对象'_Worksheet'的方法'范围'失败。

此行发生错误:ws.Range(“A2:AJ”)。复制

如果有帮助,我正在使用Excel 2013。

感谢您的帮助。

    Option Explicit

    Sub CheckData()

        Dim Lastrow, Newrow As Long
        Dim i As Long
        Dim ws As Worksheet
        Dim rng As Range

    ' Turn off notifications
        Application.ScreenUpdating = False

        Set ws = Worksheets("Sheet1")
        Set rng = ws.Range("A2:AJ2")

        Workbooks.OpenText Filename:="C:\Test.xlsx"
        With Workbooks("Test.xlsx").Worksheets("Sheet1")

            Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            For i = 2 To Lastrow

                If IsError(Application.Match(.Cells(i, "A").Value, ws.Columns("A"), 0)) Then

                   Newrow = ws.Range("A1").End(xlDown).Row + 1
                   .Cells(i, "A").Copy ws.Cells(Newrow, "A")
                   .Cells(i, "B").Copy ws.Cells(Newrow, "E")
                   .Cells(i, "C").Copy ws.Cells(Newrow, "F")
                   .Cells(i, "D").Copy ws.Cells(Newrow, "G")
                   .Cells(i, "E").Copy ws.Cells(Newrow, "H")
                   ws.Cells(Newrow, "I") = "New submission created on" & " " & .Cells(i, "L")
                   .Cells(i, "F").Copy ws.Cells(Newrow, "J")
                   .Cells(i, "G").Copy ws.Cells(Newrow, "K")
                   .Cells(i, "H").Copy ws.Cells(Newrow, "L")
                   .Cells(i, "I").Copy ws.Cells(Newrow, "M")
                   .Cells(i, "J").Copy ws.Cells(Newrow, "N")
                   ws.Cells(Newrow, "AJ") = Format(Date, "yyyy-mm-dd")

                   'New Code

                   ws.Range("A2:AJ").Copy
                   ws.Cells(Newrow, "A").PasteSpecial _
                   Paste:=xlPasteFormats, Operation:=xlNone, _
                   SkipBlanks:=False, Transpose:=False
                   Application.CutCopyMode = False

                   'End New Code

                End If

            Next i

        End With

        Workbooks("Test.xlsx").Close savechanges:=False

    ' Turn on notifications
        Application.ScreenUpdating = True

    ' Message Box showing that process is complete.

        MsgBox "Done!"

    End Sub

0 个答案:

没有答案