从一个工作簿传输到另一个工作簿

Question

从一个工作簿传输到另一个工作簿的VBA代码。例如，我有一个工作簿，每个部门有多个工作表。一旦项目完成，我手动复制并粘贴到完成的工作簿。我需要帮助创建一个VBA代码，只将完成的项目更新为完成的主工作簿。我尝试了下面的VBA代码，但它将所有的工作表传输到一个工作表，而这不是我正在寻找的。

Sub SummurizeSheets() 
    Dim ws As Worksheet 
    Application.ScreenUpdating = False 
    Sheets("Sales").Activate 
    For Each ws In Worksheets 
     If ws.Name <> "Sales" Then 
      ws.Range("A2:K45").Copy 
      Worksheets("Sales").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues) 
     End If 
    Next ws 
End Sub 

我需要单元格A2：I45复制已完成主簿，如果电池i有完成它的项目。希望这是有道理的，否则我可以附上excel工作簿。 所以，我有4个工作表的每个销售地点。例如worksheet1是Sales，然后是其他Sales2 ... ect ...所有工作表包含相同的数据，但不同的部门区域编辑每个工作表，这就是为什么有多个工作表。一旦它们全部由各个部门完成，我希望这4个工作表转移到完成的工作簿中的一个工作表中。

Answer 1

更新时间：

Sub SummarizeSheets() 
    Dim ws As Worksheet, rw As Range, cDest As Range 
    Dim wbDest As Workbook, wbSource As Workbook 
    Dim rngSrc As Range, x As Long 

    Set wbSource = ActiveWorkbook 'set source of data 

    ' set the destination for completed items: adjust names to suit 
    Set wbDest = Workbooks("Completed.xlsx") ' must be already open ! 
    Set cDest = wbDest.Worksheets("Complete").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 

    Application.ScreenUpdating = False 

    For Each ws In wbSource.Worksheets 
     If ws.Name <> "Sales" Then 
      Set rngSrc = ws.Range("A2:K45") 
      ' step backwards since we might be deleting rows... 
      For x = rngSrc.Rows.Count To 1 Step -1 
       Set rw = rngSrc.Rows(x) 
       If UCase(rw.Cells(1, "I").Value) = "COMPLETED" Then 
        cDest.Resize(1, rw.Columns.Count).Value = rw.Value 
        rw.EntireRow.Delete   'delete from source 
        Set cDest = cDest.Offset(1, 0) 'set next destination row 
       End If 
      Next x 
     End If 
    Next ws 
End Sub