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

[malleshg24]

Hi Team,
I want to consolidate all workbooks data into masterworkbook. I receive daily report which contain 8 sheets
From this report I copy ( sheets1, sheet2, sheet4 and sheet5 data ) and paste into master sheets under (sheets1, sheet2, sheet4 and sheet5 ) respectively.
Below I have one code which consolidate all sheets data into master sheets. But this time my task is different copying specific sheets data and pasting masterworkbooks specific sheets.

Sub CosolodiateFromDifferentworkbook()
Dim wbk As Workbook
Dim sht As Worksheet, Nsht As Worksheet
    Application.ScreenUpdating = False
    
        FP = "C:\Users\AFCKS TECHNOLOGIES\Desktop\STVB004\Todays Report\"
        FN = Dir(FP)
        
    Set sht = Sheets.Add(, Sheets("Task"))
        sht.Name = "Master"
        
    
    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
    Loop
    
        Set wbk = Nothing
        
    Application.ScreenUpdating = True
        
        MsgBox " Data consolodiate successfully !", vbInformation, "Data Import"
      
    
End Sub

Please suggest what changes to make

Thanks for your precious time

Regards,
Mallesh

[mana]

Option Explicit

Sub test()
    Dim wbk As Workbook
    Dim wsn
    Dim wsCount As Long
    Dim FP As String, FN As String
    Dim i As Long
    
    Application.ScreenUpdating = False
    
    Set wbk = ThisWorkbook 'Masterworkbooks
    wsn = Array("Sheet1", "Sheet2", "Sheet4", "Sheet5")
    wsCount = UBound(wsn)

    FP = "C:\Users\AFCKS TECHNOLOGIES\Desktop\STVB004\Todays Report\"
    FN = Dir(FP & "*.xlsx")

    Do Until FN = ""
        With Workbooks.Open(FP & FN)
            For i = 0 To wsCount
                .Sheets(wsn(i)).Cells(1).CurrentRegion.Offset(1).Copy _
                    wbk.Sheets(wsn(i)).Cells(Rows.Count, 1).End(xlUp).Offset(1)
            Next
            .Close False
        End With
        
        FN = Dir
        
    Loop

    Application.ScreenUpdating = True
    
    MsgBox " Data consolodiate successfully !", vbInformation, "Data Import"
    
End Sub

マナ

[malleshg24]

Thank you so much you are great bro !!!

[malleshg24]

Hi Mana /Team


The above code works for me, for consolidating all workbooks data into master.
So this time the task is, for preparing WBR (Weekly Report) user like to select only
few files of the week through mso file picker (multiple file select = true)
So I am looking for vba code to consolidate multiple file selected by user.

 once Again thanks in advance for your precious time.


Regards,
Mallesh

[mana]

Option Explicit
 
Sub test2()
    Dim fList, f
    Dim wbk As Workbook
    Dim wsn
    Dim wsCount As Long
    Dim i As Long
    
    fList = Application.GetOpenFilename( _
            FileFilter:="Excel Book ,*.xlsx", MultiSelect:=True)
    If Not IsArray(fList) Then Exit Sub
     
    Application.ScreenUpdating = False
     
    Set wbk = ThisWorkbook 'Masterworkbooks
    wsn = Array("Sheet1", "Sheet2", "Sheet4", "Sheet5")
    wsCount = UBound(wsn)


    For Each f In fList
        With Workbooks.Open(f)
            For i = 0 To wsCount
                .Sheets(wsn(i)).Cells(1).CurrentRegion.Offset(1).Copy _
                wbk.Sheets(wsn(i)).Cells(Rows.Count, 1).End(xlUp).Offset(1)
            Next
            .Close False
        End With
    Next
     
    MsgBox " Data consolodiate successfully !", vbInformation, "Data Import"
     
End Sub

マナ

[malleshg24]

Hi Mana/Team,

Thanks a lot for a Solution. I need one more help here plz.
 I have multiple filePath in range b5 and want to connect those file one by one to your code.

plz assist?...

fList = Application.GetOpenFilename( _ 
    FileFilter:="Excel Book ,*.xlsx", MultiSelect:=True) 
    If Not IsArray(fList) Then Exit Sub

My code below for selecting multiple files. it works.
Option Explicit
Sub Multiple_File_Select()
    Dim fd          As FileDialog
    Dim strFiles     As String
    Dim i            As Integer
    Dim filechosen As Variant
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.InitialFileName = "E:\Pivot\mallesh"
    fd.InitialView = msoFileDialogViewList
    'allow multiple file selection
    fd.AllowMultiSelect = True
    filechosen = fd.Show
    With ActiveSheet
        If fd.SelectedItems.Count Then
            For i = 1 To fd.SelectedItems.Count
                If strFiles = "" Then strFiles = fd.SelectedItems(i) Else strFiles = strFiles & vbLf & fd.SelectedItems(i)
           Next i
            .Range("B5").Value = strFiles
        End If
    End With
End Sub


Regards,
Mallesh