Results 1 to 2 of 2

Thread: vba consolidation of specific sheets data and Pasting in specific Mater sheets

  1. #1

    vba consolidation of specific sheets data and Pasting in specific Mater sheets

    Hi Team,

    I want to consolidate all workbooks in master workbook.

    From daily report file which has Total 14 sheets, I pick up only my teams data,
    My Teams Data are in sheets (sheet1,sheet2,sheet3 sheet4 and sheet6 sheet8 ) and every sheets got name also here.
    My task is pick sheet1 data Paste in Master workbooks sheet1, sheet2-sheet2 and so on.

    every sheets has header here. Sometime in sheet6 and sheet8. there will not be any data. then ignore these .

    Below are my code that work for single workbooks single sheet consolidation,

    But this time the task is completely different. plz assist.

    Sub CosolodiateFromDifferentworkbook() 
        Dim wbk As Workbook 
        Dim sht As Worksheet, Nsht As Worksheet 
        Application.ScreenUpdating = False 
        FP = "C:\Users\Desktop\Todays Report\" 
        FN = Dir(FP) 
        Set sht = Sheets.Add(, Sheets("Task")) 
        sht.Name = "Master" 
        With sht.Range("A1:E1") 
            .Value = Array("Date", "Curr", "Agent", "Product", "Sales") 'i can increate the array here as per my requ
            .Font.Bold = True 
            .Interior.Color = 15123099 
            .Font.Size = 16 
            .Font.Name = "Algerian" 
            .HorizontalAlignment = xlCenter 
            .VerticalAlignment = xlCenter 
        End With 
        Do Until FN = "" 
            lr = sht.Cells(Rows.Count, 1).End(xlUp).Row + 1 
            Set wbk = Workbooks.Open(FP & FN) 
             ' To open workbook  , need to mention File path & File name
            Set Nsht = wbk.Sheets(1) 
            Nsht.Range("A1").CurrentRegion.Offset(1).Copy sht.Range("A" & lr) 
            wbk.Close False 
            FN = Dir 
        sht.Range("A1").CurrentRegion.Borders.LineStyle = -4119 
        sht.Range("A1").CurrentRegion.BorderAround 1, xlThick 
        ActiveWindow.DisplayGridlines = False 
        Set wbk = Nothing 
        Application.ScreenUpdating = True 
        MsgBox " Data consolodiate successfully !", vbInformation, "Data Import" 
    End Sub 
    Formatting tags added by mark007
    Last edited by SamT; 01-12-2018 at 04:06 PM.

  2. #2
    For Each shtn In Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet6", "Sheet8") 
        wbk.Sheets(shtn).Range("A1").CurrentRegion.Offset(1).Copy _ 
        sht.Cells(Rows.Count, 1).End(xlUp).Offset(1) 
    Formatting tags added by mark007

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts