從一個工作簿傳輸到另一個工作簿

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