复制单元格范围并根据日期粘贴到另一个工作表中?

时间:2019-04-26 07:52:49

标签: excel vba

我已经在互联网上搜寻了任何解决方案,但我一直空着,所以希望有人可以帮助我。我有两张纸,Sheet1Inventory.Sheet 1中,用户在B1中输入日期。在C4:C200范围内,我有一个耗材列表,在D4:D200范围内,用户输入了手头上每个耗材的数量。在“库存”中,耗材列表在A1:A200范围内,并且b1:z1列出日期。

我正在尝试创建一个宏,该宏将在Sheet1中查找在B1中输入的日期,假设4/1/19,复制D4:D200,然后在Inventory中查找4/1/19,行b1:z1并将复制的数据粘贴到正确的日期下方。因此,如果4/1/19在单元格E1中,则值将粘贴在E2中。

虽然我对单元格公式和函数很满意,但是我是宏的新手,所以我不确定该怎么做。任何帮助都将不胜感激!

1 个答案:

答案 0 :(得分:0)

我试图编写一些非常基本的代码,使您可以轻松阅读它。它不是最复杂的代码,但可以完成工作。我注意到的几件事:清单197中的耗材数量很长,库存状态表中列出了200件物品...好吧,您可以轻松地调整下面的宏。将代码复制到新模块中并运行。如果您遇到任何问题,请发布完整的工作簿,我会看一下。确保清单上的单元格a1不为空。

Sub DoYourThing()
Dim c As Integer

  c = findHorizontal("Inventory", 1, Sheets("Sheet1").Cells(1, 2).Value)
  'now we know what column the date is in
  For i = 2 To 200
    Sheets("Inventory").Cells(i, c) = Sheets("Sheet1").Cells(i + 2, 5)
  Next i
End Sub

Function findHorizontal(Sheet As String, row As Integer, Value As Variant) As Integer
'searches a row from left to right until the cells are empty
Dim i As Integer

  i = 1

  Do While Not IsEmpty(Sheets(Sheet).Cells(row, i))
    If Sheets(Sheet).Cells(row, i) = Value Then
      findHorizontal = i
      Exit Function
    End If
    i = i + 1
  Loop

  findHorizontal = -1
End Function