Summarize data from worksheets into one worksheet.

Milind Agarwal
Milind Agarwal used Ask the Experts™
on
Hi Everyone,
I have a workbook Lets say WorkbookA with multiple Tabs. I want to create a WorkbookB with a single tab.  Column A(WorkbookB) going to be the sr. no. Column B(WorkbookB) is coming from Column G of Workbook A. Column C(WorkbookB) is coming from Column D of WorkbookA. Column D(WorkbookB) is coming from Column F of workbookA. Column E(WorkbookB) is coming from Column E of WorkbookA and when the Column J of Workbook A has "Yes". Wondering if this can be achieved thru VB. Any help will be appreciated. Please find the attachment.
WorkbookA.xlsx
WorkbookB.xlsx
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
View Solution Only
Saurabh Singh Teotia
Top Expert 2015

Commented:
Quick question are you open to your workbook B template sheet present in Workbook A itself and once you run the macro it clears the old data and collates the new data in it and then you can do a move and copy .of the worksheet..create a copy and save it as a new workbook everytime..are you open to this idea??
Milind Agarwal

Author

Commented:
Yeah that would work!
Top Expert 2015
Commented:
Enclosed is your file along with updated code which does what you are looking for..I moved your log to workbook A to do the necessary code part...

Option Explicit

Sub getdata()
    Dim ws1 As Worksheet, ws As Worksheet
    Dim lrow As Long, cell As Range, rng As Range
    Dim lr As Long
    Set ws1 = Sheets("Log")

    lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    If lr > 1 Then ws1.Range("A3:X" & lr).Clear

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> ws1.Name Then
            lrow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            If lrow > 5 Then
                Set rng = ws.Range("J6:J" & lrow)

                For Each cell In rng

                    lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

                    If UCase(Trim(cell.Value)) = "YES" Then
                        ws1.Range("A" & lr).Value = Application.WorksheetFunction.Max(ws1.Range("a:a")) + 1
                        ws1.Range("b" & lr).Value = ws.Range("G" & cell.Row).Value
                        ws1.Range("C" & lr).Value = ws.Range("D" & cell.Row).Value
                        ws1.Range("D" & lr).Value = ws.Range("F" & cell.Row).Value
                        ws1.Range("E" & lr).Value = ws.Range("E" & cell.Row).Value
                    End If


                Next cell

            End If
        End If

    Next ws

End Sub

Open in new window

WorkbookA-1.xlsm
Milind Agarwal

Author

Commented:
Thanks Saurabh really appreciate it.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial