If you want to merge data from specific sheets from multiple workbooks into single workbook. For example i have 10 -20 workbooks in a folder and i want to copy data from two sheets only like "ashish", "koul" from each workbook to a new workbook with same sheet names "ashish", "koul". All data from multiple workbooks from sheet name ashish shoul be merged into new workbooks sheet name "ashish" ,etc.
Here is the code-
Sub getfilen()
'********************* to get file names in folder
Dim j As Long
Dim fldpath
Dim fld, fil As Object
j = 2
Range("a2").Select
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choose Folder"
Application.FileDialog(msoFileDialogFolderPicker).Show
fldpath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
Set fso = CreateObject("scripting.filesystemobject")
Set fld = fso.getfolder(fldpath)
For Each fil In fld.Files
' will search for excel files only
If UCase(Right(fil.Path, 4)) = UCase(".xls") Or UCase(Right(fil.Path, 5)) = UCase(".xlsx") Then
Cells(j, 1).Value = fil.Path
j = j + 1
End If
Next fil
End Sub
Sub consolidatefromdifferentworkbooks()
'**************************** MERGE DATA ***************************
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ask, ask2, ask3 As Workbook
Dim i, j, ash, ash1 As Long
Dim N, z, r, s, k As Long
Set ask3 = ThisWorkbook
Set ask = Workbooks.Add
ask3.Activate
For j = 2 To ask3.Sheets(1).Range("b65356").End(xlUp).Row
wks = ask3.Sheets(1).Cells(j, 2).Value
ask.Activate
ask.Sheets.Add After:=ask.Sheets(ask.Sheets.Count)
ask.Sheets(ask.Sheets.Count).Name = wks
ask3.Activate
Next j
ask.Activate
ask.Sheets("Sheet1").Delete
ask.Sheets("Sheet2").Delete
ask.Sheets("Sheet3").Delete
r = ThisWorkbook.Sheets(1).Range("A65356").End(xlUp).Row
For i = 2 To r
For ash = 2 To ThisWorkbook.Sheets(1).Range("b65356").End(xlUp).Row
ask3.Activate
Workbooks.Open Filename:=Sheets(1).Range("a" & i).Value
Set ask2 = ActiveWorkbook
For ash1 = 1 To ask2.Worksheets.Count
If UCase(ask2.Sheets(ash1).Name) = UCase(ThisWorkbook.Sheets(1).Range(" b" & ash).Value) Then
ask2.Sheets(ash1).Select
N = Range("A1").SpecialCells(xlLastCell).Row
If N >= 2 Then
Rows("1:" & N).Select
Selection.Copy
ask.Activate
ask.Sheets(ThisWorkbook.Sheets(1).Range(" b" & ash).Value).Activate
ActiveSheet.Cells(Range("A1").SpecialCells(xlLastCell).Row + 1, 1).Select
ActiveSheet.Paste
End If
Exit For
End If
Next ash1
Next ash
ask2.Activate
ask2.Close
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Excel Macro File http://www.filefactory.com/file/cda5473/n/NEW_merge_from_different_workbooks.xlsm
Subscribe to:
Post Comments (Atom)
Import data from SQL
Macro to import data from SQL using ADO connection string: Sub Import_data_from_SQL() ' Tools -> References -> Microsoft Active...
-
If you want to copy the data from pdf file to Excel. Sub method1_using_sendkey() Dim task ' open the file ' change the path of ...
-
Macro to import data from SQL using ADO connection string: Sub Import_data_from_SQL() ' Tools -> References -> Microsoft Active...
No comments:
Post a Comment