复制一张纸上的数据并粘贴到第二张纸上的错误位置

我有代码从1页（引用）1单元格位置复制选定的数据并将其粘贴到表2上另一个位置（VOC_ASST）。 这里是代码：

`Sub VOC_ASST() 'Copies names from "Monthly Referals" sheet to "Voc_ Asst" Sheet. 'Prevents duplication of names. Dim All As Range, R As Range Dim Data With Sheets("Referrals") 'Find all VR Set All = FindAll(.Range("M:M"), "VR") If All Is Nothing Then MsgBox "No VR found." Exit Sub End If 'Map to column B Set All = Intersect(All.EntireRow, .Range("B:B")) 'Get unique names Data = UniqueItems(All, vbTextCompare) End With 'Transpose to rows Data = WorksheetFunction.Transpose(Data) With Sheets("VOC_ASST") 'Find last column Set R = .Cells(3, .Columns.Count).End(xlToLeft).Offset(, 0) 'Write the data R.Resize(UBound(Data), 1).Value = Data End With End Sub Private Function FindAll(ByVal Where As Range, ByVal What, _ Optional ByVal After As Variant, _ Optional ByVal LookIn As XlFindLookIn = xlValues, _ Optional ByVal LookAt As XlLookAt = xlWhole, _ Optional ByVal SearchOrder As XlSearchOrder = xlByRows, _ Optional ByVal SearchDirection As XlSearchDirection = xlNext, _ Optional ByVal MatchCase As Boolean = False, _ Optional ByVal SearchFormat As Boolean = False) As Range 'Find all occurrences of What in Where (Windows version) Dim FirstAddress As String Dim c As Range 'From FastUnion: Dim Stack As New Collection Dim Temp() As Range, Item Dim i As Long, j As Long If Where Is Nothing Then Exit Function If SearchDirection = xlNext And IsMissing(After) Then 'Set After to the last cell in Where to return the first cell in Where in front if _ it match What Set c = Where.Areas(Where.Areas.Count) 'BUG in XL2010: Cells.Count produces a RTE 6 if C is the whole sheet 'Set After = C.Cells(C.Cells.Count) Set After = c.Cells(c.Rows.Count * CDec(c.Columns.Count)) End If Set c = Where.find(What, After, LookIn, LookAt, SearchOrder, _ SearchDirection, MatchCase, SearchFormat:=SearchFormat) If c Is Nothing Then Exit Function FirstAddress = c.Address Do Stack.Add c If SearchFormat Then 'If you call this function from an UDF and _ you find only the first cell use this instead Set c = Where.find(What, c, LookIn, LookAt, SearchOrder, _ SearchDirection, MatchCase, SearchFormat:=SearchFormat) Else If SearchDirection = xlNext Then Set c = Where.FindNext(c) Else Set c = Where.FindPrevious(c) End If End If 'Can happen if we have merged cells If c Is Nothing Then Exit Do Loop Until FirstAddress = c.Address 'Get all cells as fragments ReDim Temp(0 To Stack.Count - 1) i = 0 For Each Item In Stack Set Temp(i) = Item i = i + 1 Next 'Combine each fragment with the next one j = 1 Do For i = 0 To UBound(Temp) - j Step j * 2 Set Temp(i) = Union(Temp(i), Temp(i + j)) Next j = j * 2 Loop Until j > UBound(Temp) 'At this point we have all cells in the first fragment Set FindAll = Temp(0) End Function Private Function UniqueItems(ByVal R As Range, _ Optional ByVal Compare As VbCompareMethod = vbBinaryCompare, _ Optional ByRef Count) As Variant 'Return an array with all unique values in R ' and the number of occurrences in Count Dim Area As Range, Data Dim i As Long, j As Long Dim Dict As Object 'Scripting.Dictionary Set R = Intersect(R.Parent.UsedRange, R) If R Is Nothing Then UniqueItems = Array() Exit Function End If Set Dict = CreateObject("Scripting.Dictionary") Dict.CompareMode = Compare For Each Area In R.Areas Data = Area If IsArray(Data) Then For i = 1 To UBound(Data) For j = 1 To UBound(Data, 2) If Not Dict.Exists(Data(i, j)) Then Dict.Add Data(i, j), 1 Else Dict(Data(i, j)) = Dict(Data(i, j)) + 1 End If Next Next Else If Not Dict.Exists(Data) Then Dict.Add Data, 1 Else Dict(Data) = Dict(Data) + 1 End If End If Next UniqueItems = Dict.Keys Count = Dict.Items Dim Msg As String, Ans As Variant Msg = "Hey!!! Copying complete!! Any Thing Else?" Ans = MsgBox(Msg, vbYesNo) Select Case Ans Case vbYes Sheets("Referrals").Select Case vbNo `GoTo Quit: End Select Quit: ActiveWorkbook.Close End Function` 

问题是，它应该开始张贴在第5行A列，并在第3行A列张贴。如果我将其更改为行1或2它张贴。 如果我将其更改为5，则不会发布。 有什么build议么？ 我从另一个地方得到了帮助，但我不记得位置。

Answer 1

确定粘贴位置的代码是行

Set R = .Cells(3, .Columns.Count).End(xlToLeft).Offset(, 0)

它正在挑选第3行中使用的最后一个单元格。因此它被粘贴到第3行。要将它放入第5行第A列，请使用

 Set R = .Cells(5, 1) 

代替。