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
    Last edited by SamT; 01-12-2018 at 04:06 PM.

  2. #2
    VBAX Expert
    Sep 2016
            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)

Posting Permissions

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