PDA

View Full Version : vba consolidation of specific sheets data and Pasting in specific Mater sheets



malleshg24
10-27-2017, 09:55 PM
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 :think::help

mana
10-27-2017, 11:19 PM
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
10-27-2017, 11:31 PM
Thank you so much you are great bro !!!

malleshg24
01-16-2018, 02:25 PM
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
01-17-2018, 03:18 AM
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
01-22-2018, 12:29 PM
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