VBA to copy paste data in Master File........and adjust row as per data size..

[malleshg24]

Hi Team


I have a master file with standard formating in it.
My task is to open each workbooks from a drive E,

example, outgoingCalls.xlsx data should be pasted in outgoingcalls header.
Incoming calls data should be pasted under incomingcalls Header and so on.....


if the data size increases needs to insert extra row to adust the size in master file.
if the data side decreases needs to delete blank rows from Master file.




There are 5-6 workbooks needs to open one by one and paste the data under heading according to Master heading.


please assist, I understand the vba code and I will modify according to my Requirement.




Regards,
Mallesh 




:help

[malleshg24]

Hi Team,

In a folder I will be having six workbooks, each workbooks rowsize usually 20+40 lines, and there are only 4 columns in each workbook.
I have to copy this data in master workbook. and data should not overlap with each other sections of Master workbook. if row size exceeds extra row should be get added in master workbook. thanks

Thanks in advance for your help


Regards
Mallesh

[Leith Ross]

Hello Mallesh,

What are the headers for the four columns?

Will the copied data start in row 5 of the Master like the posted workbook?

[Leith Ross]

Hello Mallesh,

This should get you started...

Sub UpdateMaster()


    Dim DstRng  As Range
    Dim DstWkb  As Workbook
    Dim DstWks  As Worksheet
    Dim File    As Object
    Dim Files   As Object
    Dim Filter  As Variant
    Dim Folder  As Object
    Dim oShell  As Object
    Dim Path    As Variant
    Dim Rng     As Range
    Dim RngBeg  As Range
    Dim RngEnd  As Range
    Dim SrcWkb  As Workbook
    Dim SrcWks  As Worksheet
    
        Set DstWkb = ThisWorkbook
        Set DstWks = DstWkb.Worksheets("Sheet1")
        Set DstRng = DstWks.Range("A5:D5")
        
        Path = "E:\"
        
        Set oShell = CreateObject("Shell.Application")
        
            Set Folder = oShell.Namespace(Path)
            If Folder Is Nothing Then
                MsgBox "The folder """ & Path & """ was Not Found.", vbCritical
                Exit Sub
            End If
            
            For Each Filter In Array("Outgoing Calls.xlsx", "Incoming Calls.xlsx", "Missed Calls.xlsx")
                Select Case UCase(Left(File.Name, 3))
                    Case Is = "OUT": Set DstRng = Array("Outgoing Calls", "Timing")
                    Case Is = "INC": Set DstRng = Array("Incoming Calls", "Timing")
                    Case Is = "MIS": Set DstRng = Array("Missed Calls", "Timing")
                End Select
                
                Set DstRng = DstRng.Offset(1, 0)
                
                Set Files = Folder.Items
                Files.Filter 64, Filter
                
                For Each File In Files
                    Set SrcWkb = Workbooks.Open(File.Path)
                        Set SrcWks = SrcWkb.Worksheets("Sheet1")
                        Set RngBeg = SrcWks.Range("A2:B2")
                        Set Rng = RngBeg
                        Set RngEnd = SrcWks.Cells(Rows.Count, "A").End(xlUp)
                        
                        If RngEnd.Row > RngBeg.Row Then Set Rng = SrcWks.Range(RngBeg, RngEnd)
                        
                        Rng.Copy DstRng
                        Set DstRng = DstRng.Offset(Files.Count, 0)
                    SrcWkb.Close SaveChanges:=False
                Next File
            Next Filter
                
End Sub

[malleshg24]

Hi Lieth,:think:

Thanks for your help, I understood your code, I will modify as per my requirement.
But one more thing needs to cover here, inserting of extra rows if range of inputdata is more 
so that It will not get pasted  in another headers of masterworkbook, or deleting extra blank row if  data size decrease. I want only one blank row above header in masterworkbook for showing different data extracted from all input files. 

Thanks in advance

Regards,

[malleshg24]

Hi Leith,

This range will be for my first workbook :=> Set RngBeg = SrcWks.Range("A2:B2")

and for next workbooks data should be below 2 heading in master workbook
and for third workbook under 3 heading in master workbook. ... and so on
data and row should get adjusted in masterworkbook.

Thanks for your precious time and solution..


Thanks
Mallesh

[Leith Ross]

Hello Mallesh,

It will be faster and easier to delete all of the data on the Master and add back the headers and associated data rather than adding and deleting rows.

[malleshg24]

Hi Leith

Thanks for your help  will adjust as you suggested, Thanks.
:bow:

Regards,
Mallesh

[malleshg24]

Hi Leith/Team,

One more help required,
How to add below workbooks Name in array, if workbook names are in range ("A2:a4") , instead of directly writing in module.
For Each Filter In Array("Outgoing Calls.xlsx", "Incoming Calls.xlsx", "Missed Calls.xlsx")

Thanks for help.

Regards,
Mallesh

[Leith Ross]

Hello Mallesh,

If the worksheet names are on "Sheet1" of the workbook that has the macro then the line would be ...

    For Each Filter In DstWks.Range(A2:A4")