将特定数据从一个工作簿转移到另一个工作簿

Question

我已经用VBA创建了一段代码，它将数据从一个工作簿传输到另一个工作簿而不用它来实现。每次运行时，它似乎都不想提供正确的信息。你们可以看看它并告诉我你看错了吗？

Sub transfer()
  Dim i As Long
  Dim j As Long
  Dim lastrow1 As Long
  Dim lastrow2 As Long
  Dim jobnum As String
  Dim mainmachine As String
  Dim WBT As Workbook ''This Workbook CNC PL
  Dim WBC As Workbook '' New workbook CapacitySummary

  Set WBT = Workbooks("CNC TEST.xlsx")
  Set WBC = Workbooks("CapacitySummary.xlsx")
  lastrow1 = WBT.Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
  lastrow2 = WBC.Worksheets("DATA").Range("A" & Rows.Count).End(xlUp).Row

  WBT.Worksheets("sheet1").Activate
  For i = 2 To lastrow1
    jobnum = WBT.Sheets("Sheet1").Cells(i, "A").Value
    mainmachine = WBT.Sheets("Sheet1").Cells(i, "K").Value
    WBC.Worksheets("DATA").Activate


    For j = 2 To lastrow2

      If WBC.Worksheets("DATA").Cells(j, "A").Value = jobnum And 
        WBC.Worksheets("DATA").Cells(j, "B").Value = mainmachine Then
        '''' Comparing data between workbooks
        WBC.Worksheets("DATA").Activate
        WBC.Worksheets("DATA").Range(Cells(i, "N"), Cells(i, "N")).Copy
        ActiveSheet.PasteSpecial Paste:=xlPasteValues
        ''''Choosing Range to copy
        WBT.Worksheets("Sheet1").Activate
        WBT.Worksheets("Sheet1").Range(Cells(j, "P"), Cells(j, "P")).Select
        ActiveSheet.Paste

        ''''Choosing Range to paste
      End If

    Next j
    Application.CutCopyMode = False

  Next i

End sub

所以，我们要做的是让宏检查两个工作簿，看看＆＃34; JobNumbers＆＃34;匹配。如果是这样，我们希望它检查＆＃34; Mach Center＆＃34;关于容量和＆＃34;当前WC＆＃34;在优先级列表上是匹配的。如果是这样，我们想要在容量列表上复制总时间并将其粘贴到Column＆＃34; P＆＃34;在优先级列表（CNC部门）上没有复制功能。

Answer 1

发现了一些错误。主要是我不了解以下两行。他们使用大量代码显然指向单个单元格。

WBC.Worksheets("DATA").Range(Cells(i, "N"), Cells(i, "N")).Copy
WBT.Worksheets("Sheet1").Range(Cells(j, "P"), Cells(j, "P")).Select

另外，我建议编码而不使用单词select或activate。放慢速度。尝试以下代码，看看它是否适合您的需要。

Sub transfer()
Dim i As Long
Dim j As Long
Dim lastrow1 As Long
Dim lastrow2 As Long
Dim jobnum As String
Dim mainmachine As String
Dim WBT As Workbook ''This Workbook CNC PL
Dim WBC As Workbook '' New workbook CapacitySummary

Set WBT = Workbooks("CNC TEST.xlsx")
Set WBC = Workbooks("CapacitySummary.xlsx")
lastrow1 = WBT.Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
lastrow2 = WBC.Worksheets("DATA").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lastrow1
jobnum = WBT.Sheets("Sheet1").Cells(i, "A").Value
mainmachine = WBT.Sheets("Sheet1").Cells(i, "K").Value


For j = 2 To lastrow2

If WBC.Worksheets("DATA").Cells(j, "A").Value = jobnum And _
WBC.Worksheets("DATA").Cells(j, "B").Value = mainmachine Then
'''' Comparing data between workbooks
WBC.Worksheets("DATA").Activate
'WBC.Worksheets("DATA").Range(Cells(i, "N"), Cells(i, "N")).Copy Destination:=WBT.Worksheets("Sheet1").Range(Cells(j, "P"), Cells(j, "P"))

WBT.Worksheets("Sheet1").Range("P" & j) = WBC.Worksheets("DATA").Range("N" & i)
'ActiveSheet.PasteSpecial Paste:=xlPasteValues
''''Choosing Range to copy
'WBT.Worksheets("Sheet1").Activate
'WBT.Worksheets("Sheet1").Range(Cells(j, "P"), Cells(j, "P")).Select
'ActiveSheet.Paste

''''Choosing Range to paste
End If

Next j
Application.CutCopyMode = False

Next i

End Sub

Answer 2

您可以尝试以下代码。它经过调整以避免和.select，.activate或.copy命令。

Dim WBT As Excel.Workbook
Dim WBC As Excel.Workbook
Dim jobNumWBT As String
Dim jonNumWBC As String
Dim mainMachine As String
Dim machCenter As String
Dim WBTpath As String
Dim WBCpath As String

WBTpath = "[insert your path here]"
WBCpath = "[insert your path here]"

Set WBT = GetObject(WBTpath)
Set WBC = GetObject(WBCpath)

For i = 2 To WBT.Worksheets(1).Cells(1048576, 1).End(xlUp).Row
    jobNumWBT = WBT.Worksheets(1).Cells(i, 1).Value
    mainMachine = WBT.Worksheets(1).Cells(i, 11).Value 'current WC
    For j = 2 To WBC.Worksheets(1).Cells(1048576, 1).End(xlUp).Row
        jobNumWBC = WBC.Worksheets("DATA").Cells(j, 1).Value
        machCenter = WBC.Worksheets("DATA").Cells(j, 2).Value
        totalTime = WBC.Worksheets("DATA").Cells(j, 14).Value

        If jobNumWBT = jobNumWBC And machCenter = mainMachine Then
            WBT.Worksheets(1).Cells(i, 16).Value = totalTime
        End If

    Next j
Next i

WBT.Save
WBC.Save
WBT.Close
WBC.Close