Vba 将数据复制并粘贴到不同的工作表查找交叉点

我正在尝试构建一个宏，它基本上将数据从

工作表（“sheet2”）

复制并粘贴到

工作表（“sheet3”）

在表2中我在A列

单元格（2,1）中有日期。结束（xlUp）。行

。下面是我对数据的快照

我有每个字段的美元和欧元的价值。使用的最后一列通常是未知的，这将有所不同

在工作表3中，如果我希望粘贴数据，我希望宏从工作表2中查找日期，如果找到，则粘贴数据。要查找的日期在列D中。第2行

棘手的部分是，美元值应该粘贴在I到K列中，然后再次粘贴在L到N列中。EUR值应粘贴在O列到Q列之间。然后在R到T列中，美元值也粘贴到此处。第3页中的列标题与第2页相同

我曾尝试过vlookup，但意识到这不是最有效的方法

第3页的结果

复制的唯一信息是值。日期已在第3页中。 也就是说，如果在第3页中找到了日期，则金额将填入右栏。不会创建新行

在美元价值部分

在EUR部分，结果如下：

上面的内容就是我认为您想要的，包括您想要的实际格式和列。

---

它从第三页的D2单元格中获取日期。它在A列的第2页上查找该日期。如果找到该日期，它将跨数据进行复制。首先是一组美元数据，然后是欧元。您将不得不更改它以将数据放入所需的列中，但我希望它能让您走上正确的轨道

@Jarom我试过一个vlookup，但这意味着每个单元格都要设置。James，我不清楚你如何将数据复制到第3页。您是指列

D

中多次出现的相同值吗？或者将列

B

复制到

G

并在美元/欧元之间进行转换？@Jarom相同的值将被复制多次over@james. 做一个第三张纸的模型，这样我们就可以看到第二张纸的第三张纸是什么，以及为什么。。。似乎相同的美元值从第2页的C列或E列复制到第3页的I-N O-T和AA-FF？？？@Perf，如有疑问，我已添加了上述感谢。我已对守则稍作修改，因为我不需要复制日期。如何让宏将数据粘贴到与表3中已有日期相同的列上？因此，表3中有一个日期列表？您在上面声明“要查找的日期在D列第2行。”这意味着该日期在单元格D2中。如果在第3页a列中有日期列表，则应按照以下内容执行。。

Option Explicit
Sub CopyIt()
  Dim CheckDate As Date
  Dim FoundRow As Integer
  Dim Range_T0_Search As String
  Dim Rownum As Integer

  '*** Go through each date on sheet 3 column A in turn and try to find it on sheet 2 ****
  For Rownum = 2 To Sheet3.Cells(2, 1).End(xlDown).Row

    '** get the date you are looking for from sheet 3 Coumn A ***
    CheckDate = Sheet3.Cells(Rownum, 1).Value

    '**** set the range where you wnat to look for the date containe din checkdate ****
    Range_T0_Search = "A2:A" & Trim(Str(Sheet2.Cells(2, 1).End(xlDown).Row))
    FoundRow = findIt(Range_T0_Search, CheckDate)

    '*** if it can't find the date on sheet2 then don't copy anything
    If FoundRow = 0 Then Exit Sub

    '*** do the USD bit *****

    Sheet3.Cells(Rownum, 2) = Sheet2.Cells(FoundRow, 3) '*** copy across usd income ***
    Sheet3.Cells(Rownum, 3) = Sheet2.Cells(FoundRow, 5) '*** copy across usd Expensies ***
    Sheet3.Cells(Rownum, 4) = Sheet2.Cells(FoundRow, 7) '*** copy across usd Tax ***

    '*** Do the Euro bit ****

    Sheet3.Cells(Rownum, 8) = Sheet2.Cells(FoundRow, 2) '*** copy across usd income ***
    Sheet3.Cells(Rownum, 9) = Sheet2.Cells(FoundRow, 4) '*** copy across usd Expensies ***
    Sheet3.Cells(Rownum, 10) = Sheet2.Cells(FoundRow, 6) '*** copy across usd Tax ***
 Next

End Sub

Function findIt(Dates_Range As String, Date_To_Find As Date) As Integer
  Dim C As Variant
  Dim Address As Range

  With Sheet2.Range(Dates_Range)
    Set C = .Find(Date_To_Find, LookIn:=xlValues)
    If Not C Is Nothing Then
        findIt = Range(C.Address).Row
    End If
End With

End Function

Option Explicit
Sub CopyIt()
  Dim CheckDate As Date
  Dim FoundRow As Integer
  Dim Range_T0_Search As String
  Dim Rownum As Integer

  '*** Go through each date on sheet 3 column A in turn and try to find it on sheet 2 ****
  For Rownum = 2 To Sheet3.Cells(2, 1).End(xlDown).Row

    '** get the date you are looking for from sheet 3 Coumn A ***
    CheckDate = Sheet3.Cells(Rownum, 1).Value

    '**** set the range where you wnat to look for the date containe din checkdate ****
    Range_T0_Search = "A2:A" & Trim(Str(Sheet2.Cells(2, 1).End(xlDown).Row))
    FoundRow = findIt(Range_T0_Search, CheckDate)

    '*** if it can't find the date on sheet2 then don't copy anything
    If FoundRow = 0 Then Exit Sub

    '*** do the USD bit *****

    Sheet3.Cells(Rownum, 2) = Sheet2.Cells(FoundRow, 3) '*** copy across usd income ***
    Sheet3.Cells(Rownum, 3) = Sheet2.Cells(FoundRow, 5) '*** copy across usd Expensies ***
    Sheet3.Cells(Rownum, 4) = Sheet2.Cells(FoundRow, 7) '*** copy across usd Tax ***

    '*** Do the Euro bit ****

    Sheet3.Cells(Rownum, 8) = Sheet2.Cells(FoundRow, 2) '*** copy across usd income ***
    Sheet3.Cells(Rownum, 9) = Sheet2.Cells(FoundRow, 4) '*** copy across usd Expensies ***
    Sheet3.Cells(Rownum, 10) = Sheet2.Cells(FoundRow, 6) '*** copy across usd Tax ***
 Next

End Sub

Function findIt(Dates_Range As String, Date_To_Find As Date) As Integer
  Dim C As Variant
  Dim Address As Range

  With Sheet2.Range(Dates_Range)
    Set C = .Find(Date_To_Find, LookIn:=xlValues)
    If Not C Is Nothing Then
        findIt = Range(C.Address).Row
    End If
End With

End Function