CODEWITHSUNDEEP
vbaexcel-2010
Avi
Avi

Reputation: 300

Macro to copy rows from multiple workbook to summary workbook with matching column value

I have different workbooks with different sheets with same Sheet name.(Book1,Book2,Book3,excel1,excel2,micorsoft etc) in a folder.

I would like to create way to have the entire row (when data is entered) transfered to a summary workbook with the matching value in a cell.please see the example table below.

If you notice the example below,I have a Book1 with worksheet1 (it also have different worksheets along with this one).

Now my requirement is to copy entire row with matching status column cell or cells (eg: NEW,research) into the workbook where macro is running,from all the workbooks in a folder.

I request if some one can help me with this macro that will be great.

Note:

Not always but Some times this data would change from time to time, so it would have to keep over-writing with the most up to date data. I would just like it all to consolidate onto 1 workbook so I can have the data from there. Is this something that can be done easily? I've tried my luck at some macros but I can't seem to get it.

Book1

Worrksheet1

column A    column B    column C        status  comment column D
                                        Update      
                                        New     
                                        Modified        
                                        New     
                                        New     
                                        Research        
                                        Research

I was lucky enough to get a code to copy from one sheet to other in a single book the code is below

Code:

Sub Foo()
Dim i As Long, iMatches As Long
Dim aTokens() As String: aTokens = Split("New,research", ",")
For Each cell In Sheets("Worrksheet1").Range("E:E")
    If (Len(cell.Value) = 0) Then Exit For
        For i = 0 To UBound(aTokens)
            If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then
                iMatches = (iMatches + 1)
                Sheets("Worrksheet1").Rows(cell.Row).Copy Sheets("final").Rows(iMatches)
            End If
        Next
Next
End Sub

Description:

This code will copy ALL rows content with the words matching NEW,research or any required in the column E : E from Worrksheet1 sheet to final sheet

Now change required in this is to copy from different workbooks in a folder(given path to directory) into single workbook in same or differ folder.

If i can have an option to email the copy like mentioned below link will be great Creating a Windows application which reads and writes excel spreadsheets + reads and writes emails

Upvotes: 0

Views: 2068

Answers (1)

Phil
Phil

Reputation: 16

I'm not entirely sure I understand what you're after...But. Open all the workbooks that you want copied. Paste the following code into a standard module in one of the workbooks (it doesn't matter which one) Run it. The code creates a new workbook and looks at every cell in row 1 of every workbook in every worksheet. (apart from the one that's just been created) If it isn't blank it copies the entire column into the new workbook in the same worksheet number and in the same column position. Cheers.

Sub alltoone()
Application.ScreenUpdating = False
j = 0
ght = 0
Set nwrk = Workbooks.Add
For i = 1 To Workbooks.Count - 1
ght = Application.WorksheetFunction.Max(ght, Workbooks(i).Worksheets.Count)
Next i
If ght > nwrk.Worksheets.Count Then
    Do
        nwrk.Worksheets.Add
    Loop Until ght = nwrk.Worksheets.Count
End If
For i = 1 To Workbooks.Count - 1
     For k = 1 To Workbooks(i).Worksheets.Count
         For t = 1 To 256
         Set fez = Workbooks(i).Worksheets(k).Cells(1, t)
         If Not fez.Value = Empty Then
         fez.EntireColumn.Copy
         nwrk.Worksheets(k).Columns(t).EntireColumn.PasteSpecial
         End If
         Next t
     Next k
 Next i
 Set nwrk = Nothing
 Set fez = Nothing
 Application.ScreenUpdating = True
 End Sub

Upvotes: 0

Related Questions