如何仅从一个工作表复制值并将其粘贴到设置了表格的工作表中?

时间:2017-08-01 14:03:11

标签: vba excel-vba excel

我试图将数据从工作表复制到另一个工作表。正在粘贴的工作表中创建了一个表,我想将值粘贴到表中。我在这里有这个代码来复制,但它没有复制。

Dim LastRow1 As Long
Dim s As Long, w As Long

With Worksheets("PlaceHolderDD")
LastRow1 = .Cells(.Rows.COUNT, "A").End(xlUp).Row
End With

With Worksheets("KYC Feedback Page 2")
w = .Cells(.Rows.COUNT, "A").End(xlUp).Row
End With

For s = 2 To LastRow1
With Worksheets("PlaceHolderDD")
.Rows(s).Resize(, 6).Copy 'Destination:=Worksheets("KYC Feedback Page 2 
").Range("A" & w)
    Worksheets("KYC Feedback Page 2").Range("A" & w).PasteSpecial 
Paste:=xlPasteValues

    w = w + 1
    End With
    Next s

1 个答案:

答案 0 :(得分:1)

根据您的代码,假设您在复制粘贴的所有行中都有数据,似乎您只是粘贴到表的第一行。以下修复在我的测试中对我有用:

更新:根据OP解决方案更改了代码,并添加了额外的内容以忽略空白行

Sub mySub()
    Dim LastRow1 As Long
    Dim s As Long, w As Long

    With Worksheets("PlaceHolderDD")
        LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    With Worksheets("KYC Feedback Page 2")
        w = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    For s = 2 To LastRow1
        Worksheets("PlaceHolderDD").Rows(s).Copy
        Sheets("KYC Feedback Page 2").Range("Table1[No.]").Select
        Selection.Offset(w, 0).Select 'Additional Line here
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        w = w + 1
    Next s

    Dim Rng As Range
    On Error Resume Next
    Set Rng = Sheets("KYC Feedback Page 2").Range("Table1[No.]").SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If Not Rng Is Nothing Then
        Rng.Delete Shift:=xlUp
    End If
End Sub