0
votes

VBA Code to transfer from one workbook to another. For example I have a workbook with multiple sheets for each department. Once the items are completed I manually copy and paste to the completed workbook. I need help creating a VBA Code that will update only the completed items to the completed master workbook. I tried the following VBA code but it transfers all the worksheets to one worksheet and that is not what I am looking for.

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

I need Cell A2:I45 to copy the items that have been completed to a master workbook if cell I has completed on it. Hope this makes sense, otherwise I can attach the excel workbooks. So, I have 4 worksheets for each sales location. for example worksheet1 is Sales, then the other Sales2...ect...All worksheets contain the same data but different department areas edit each worksheet, this is why there are multiple worksheets. Once they are all completed by each department, I want those 4 worksheets to transfer to one worksheet in the completed workbook.

1
Clarification, so you copy and paste each department worksheet to another workbook with the same per department worksheet but only contains those that are completed? And not consolidate all the worksheet to one?L42
Well, what I have an excel spreadsheet with multiple departments and each sheet contains the same header row. Each department adds there comments and changes to their corresponding department and marks the each item complete or pending. All the completed items from each department tab get transferred over to a completed excel workbook. We only use the worksheet with multiple tabs for data entry and updates until they are completed. So we do consolidate all the completed items in one at the end of the month and delete them from the each tab.BKGirl

1 Answers

0
votes

Updated:

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