Hi VB Experts,
Please somebody help me to create this macro.
I am very new to VB, I need an help to create a macro which should copy the data from multiple excel files which are stored
in one location and paste it into the single master file. Could you please help me to create this macro, i need this macro
some how otherwise i need to work on all 500 files manually
I have 500 workbooks which are saved as the different filename, for example each file name which is saved in the name of Item
number. for example CIS11-0984-01MUR02.xls, TRIAG57757Q.xls, TYC0246458.xls, CIS11-1374-01.xls, CIS11-1531-01.xls,
CIS11-219285.xls, CIS25-0697-01.xls, CIS25-0723-01.xls, CIS26-0900-01.xls, CIS27-0875-01.xls etc...
file contains 2 worksheets named "AWF" & "Calculations". I need to open each file for example open CIS11-0984-01MUR02.xls
and copy the data from the cell "B2" from the "AWF" worksheet and paste in the master file named as "Master.xls" in the cell
"A1" and again copy the Total_Liab value from the sheet named "Calculations from the same workbook which is the last cell
value in the column Q(example: Q51 in the Calculations sheet(the range will vary from file to file)) and paste that in the
cell "B1" in the same "Master.xls" file.
Once it perform the action it should close the CIS11-0984-01MUR02.xls file and then open the TRIAG57757Q.xls file
automatically and should follow the same procedure as the CIS11-0984-01MUR02.xls . Could you please help me to create this
I have got this below macro from some of the website.
It full the correct data for some files and it doesnt work for some other file it is just copying and pasting same item
number and pasting in the column B instead of total liability value.
Dim i As Integer
Dim strPath As String
Dim wb As Workbook
Dim NewWb As Workbook
Dim NewR As Range
Dim NewR1 As Range
Dim SavePath As String
strPath = "D:MACROAWFItem" 'Change this to path of folder with files
"D:MACROAWFItemCombined.xls" 'Change this to the path and filename you want the
'new workbook to be saved as
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set NewWb = Workbooks.Add
NewWb.Sheets(1).Name = "Master"
Set NewR = NewWb.Sheets(1).Range("A1")
Set NewR1 = NewWb.Sheets(1).Range("B1")
If ActiveSheet.Cells(1, 1) = "" Then
ActiveCell.FormulaR1C1 = "Site_PN"
Columns("A:A").ColumnWidth = 23.43
ActiveCell.FormulaR1C1 = "Tot_Lia"
Columns("B:B").ColumnWidth = 17.43
Selection.Font.Bold = True
Selection.Font.ColorIndex = 5
.Name = "MS Reference Sans Serif"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.LookIn = strPath
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Set wb = Workbooks.Open(.FoundFiles(i), False)
Set NewR = NewWb.Sheets(1).Range("A" & NewWb.Sheets(1).Cells.Rows.Count).End(xlUp).Offset(1, 0)
Set NewR1 = NewWb.Sheets(1).Range("B" & NewWb.Sheets(1).Cells.Rows.Count).End(xlUp).Offset(1, 0)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set NewWb = Nothing
Set wb = Nothing
Set NewR = Nothing
Set NewR1 = Nothing
Thanks in Advance,