使用日期将数据从工作簿复制到带有VBA的工作簿

Question

我有两本试图通过以下方法实现以下目的的书：

1）主管打开他们的每日报告，然后单击（第一班/第二班/或第三班）。然后，他们输入其生产的产品总数（产品1值= P4，产品2值= P6，产品3值= P8，产品4值= P9）

2）然后，他们使用工作表上的按钮提交表单，并完成以下操作 一种。上面列出的总值将转移到另一个未打开的工作簿中，并相应地进行记录。产品1 = C2，产品2 = C5，产品3 = C8，产品4 = C11，它对应于日志中的相应日期。

Wkbk的第二部分

然后我的下一个操作员进入并进行选择（第1个班次/第2个班次/或第3个班次）。他们输入其生产的产品总数（产品1的值= P4，产品2的值= P6，产品3的值= P8，产品4的值​​= P9）

然后他们使用工作表上的按钮提交表单，并完成以下操作 一种。上面列出的总值将转移到另一个未打开的工作簿中，并相应地进行记录。产品1 = C3，产品2 = C6，产品3 = C9，产品4 = C13，对应于日志中的相应日期。

等3个班次......

第二天，他们进来并重新做一遍，提交的总数将移至零件运行日期的相应列。

我也忘记提及他们提交表单时，它会自动将其保存在名称中带有日期和班次的指定位置，并生成一封电子邮件，发送给需要查看此数据的预定收件人列表以一天为周期。

我不确定如何使日期功能正常工作，以便使数据进入日志中的正确位置。我也不确定如何根据日期将单元格索引到适当的位置。任何帮助将不胜感激。

到目前为止的代码：

Sub TransferData()

Dim WkBk As Workbook
Dim SrcWkBk As Workbook
Dim Shift As Integer
Dim myDate As Date

Set SrcWkBk = ThisWorkbook
Set WkBk = Workbooks.Open(Filename:="C:\FILE LOCATION.xlsm")
dDate = SrcWkBk.Sheets("Hourly Counts").Range("E2")
'Set rCell = Worksheets("Sheet1").Range("C1:V1").Find(What:=dDate, LookAt:=xlWhole, MatchCase:=False)

Shift = Range("B2").Value

With WkBk
Dim rCell As Range
Set rCell = Worksheets("Sheet1").Range("C1:V1").Find(What:=dDate, LookAt:=xlWhole, MatchCase:=False)

'Copy Total Number of Parts per Line
If Shift = 1 Then

 SrcWkBk.Sheets("Hourly Counts").Range("P4").Copy
   WkBk.Worksheets("Sheet1").Range("C2").PasteSpecial Paste:=xlPasteValues
   SrcWkBk.Sheets("Hourly Counts").Range("P6").Copy
   WkBk.Worksheets("Sheet1").Range("C5").PasteSpecial Paste:=xlPasteValues

ElseIf Shift = 2 Then
SrcWkBk.Sheets("Hourly Counts").Range("P4").Copy
   WkBk.Worksheets("Sheet1").Range("C3").PasteSpecial Paste:=xlPasteValues
   SrcWkBk.Sheets("Hourly Counts").Range("P6").Copy
   WkBk.Worksheets("Sheet1").Range("C6").PasteSpecial Paste:=xlPasteValues

ElseIf Shift = 3 Then
SrcWkBk.Sheets("Hourly Counts").Range("P4").Copy
   WkBk.Worksheets("Sheet1").Range("C4").PasteSpecial Paste:=xlPasteValues
   SrcWkBk.Sheets("Hourly Counts").Range("P6").Copy
   WkBk.Worksheets("Sheet1").Range("C7").PasteSpecial Paste:=xlPasteValues

End If

End With


'wkbook the code resides in....
WkBk.SaveAs ("C:\FILE LOCATION" & Format(Date, "MM-DD-YYYY") & ".xlsm")
Clear Clipboard
Application.CutCopyMode = False

End Sub

这是程序集将在提交数据以将其记录到日志文件（图2）之前将其数据输入到的主文件（图1）。

Answer 1

这是您正在做的事情的更简洁的版本，因为我打算再次讨论并稍后进行调整。

Sub TransferData()

    Dim wsS As Worksheet
    Set wsS = ThisWorkbook.Sheets("Hourly Counts")

    Dim wsD As Workbook
    Set wsD = Workbooks.Open(Filename:="C:\FILE LOCATION.xlsm").Sheets(1)

    'Dim dDate As Date
    'dDate = wsS.Range("E2").value
    '
    'Dim rCell As Range
    'Set rCell = wsD.Range("C1:V1").Find(What:=dDate, LookAt:=xlWhole, MatchCase:=False)

    Select Case wsS.Range("B2").Value2
        Case 1
            wsD.Range("C2").Value2 = wsS.Range("P4").Value2
            wsD.Range("C5").Value2 = wsS.Range("P6").Value2
        Case 2
            wsD.Range("C3").Value2 = wsS.Range("P4").Value2
            wsD.Range("C6").Value2 = wsS.Range("P6").Value2
        Case 3
            wsD.Range("C4").Value2 = wsS.Range("P4").Value2
            wsD.Range("C7").Value2 = wsS.Range("P6").Value2
    End Select

    wbD.SaveAs ("C:\FILE LOCATION" & Format(Date, "MM-DD-YYYY") & ".xlsm")

End Sub

但是，我强烈建议您为工作表创建一个小型的模型版本，以便我或其他人可以看到您真正想要完成的工作。这样做可以帮助我/我们回答这样的问题

  

    

不确定如何使日期功能正常工作，以便使数据进入日志中的正确位置

  

     

它会自动将其保存在带有日期的指定位置

此“指定位置”在哪里？

工作该项目的一种方法是根据从Now()函数获得的日期结果进行搜索，并检查今天的DateDiff()减去某一天是否匹配。