我试图将数据从工作表复制到另一个工作表。正在粘贴的工作表中创建了一个表,我想将值粘贴到表中。我在这里有这个代码来复制,但它没有复制。
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
答案 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