Hi all
I have been working on a macro to pull several different values from excel workbooks that are in one folder to one master file
I am stuck with the final bit.
B12:B1300 is filtered to only show if the value in column D is >0 and i want to be able to copy these values and put them into the row that the macro is already in, in my 'master' sheet
The row that I keep having an issue with is in bold.
It is also incredibly slow - probably 30seconds to go through about 20files. Is there anything i can do to speed it up?
Thanks
Jon
Sub workingmacro()
Application.EnableCancelKey = xlDisabled
Dim folderPath As String
Dim Filename As String
Dim wb As Workbook
folderPath = "C:\Users\jonnys\excel" 'contains folder path
If Right(folderPath, 1) <> "" Then folderPath = folderPath + ""
Filename = Dir(folderPath & "*.xlsx")
Do While Filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & Filename)
'Copy Job Name from workbooks in excel file
Sheets("Requisition Sheet").Range("F9").Copy
Workbooks("master").Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
'Copy 100number from workbooks in excel file
Sheets("Requisition Sheet").Range("F6").Copy
Workbooks("master").Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial
'Copy date from workbooks in excel file
Sheets("Requisition Sheet").Range("C6").Copy
Workbooks("master").Worksheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial
'Copy electrical/plumbing from workbooks in excel file put =electrical/plumbing on requisition sheet
Sheets("Requisition Sheet").Range("F4").Copy
Workbooks("master").Worksheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Offset(1, 0).PasteSpecial
'Copy ?from workbooks in excel file
Sheets("Requisition Sheet").Range("G4").Copy
Workbooks("master").Worksheets("Sheet1").Cells(Rows.Count, "E").End(xlUp).Offset(1, 0).PasteSpecial
'Copy requested items
Sheets("Requisition Sheet").Range("B14", Range(B14).End(xlDown).End(xlToRight)).SpecialCells(xlCellTypeVisible).Copy
Workbooks("master").Worksheets("Sheet1").Range("F2").End(xlToRight).Paste
'go to last filled cell in column A
Range("A1").End(xlToRight).Select
Workbooks(Filename).Close True
Filename = Dir
Loop
Application.ScreenUpdating = True
End Sub
I have been working on a macro to pull several different values from excel workbooks that are in one folder to one master file
I am stuck with the final bit.
B12:B1300 is filtered to only show if the value in column D is >0 and i want to be able to copy these values and put them into the row that the macro is already in, in my 'master' sheet
The row that I keep having an issue with is in bold.
It is also incredibly slow - probably 30seconds to go through about 20files. Is there anything i can do to speed it up?
Thanks
Jon
Sub workingmacro()
Application.EnableCancelKey = xlDisabled
Dim folderPath As String
Dim Filename As String
Dim wb As Workbook
folderPath = "C:\Users\jonnys\excel" 'contains folder path
If Right(folderPath, 1) <> "" Then folderPath = folderPath + ""
Filename = Dir(folderPath & "*.xlsx")
Do While Filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & Filename)
'Copy Job Name from workbooks in excel file
Sheets("Requisition Sheet").Range("F9").Copy
Workbooks("master").Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
'Copy 100number from workbooks in excel file
Sheets("Requisition Sheet").Range("F6").Copy
Workbooks("master").Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial
'Copy date from workbooks in excel file
Sheets("Requisition Sheet").Range("C6").Copy
Workbooks("master").Worksheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial
'Copy electrical/plumbing from workbooks in excel file put =electrical/plumbing on requisition sheet
Sheets("Requisition Sheet").Range("F4").Copy
Workbooks("master").Worksheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Offset(1, 0).PasteSpecial
'Copy ?from workbooks in excel file
Sheets("Requisition Sheet").Range("G4").Copy
Workbooks("master").Worksheets("Sheet1").Cells(Rows.Count, "E").End(xlUp).Offset(1, 0).PasteSpecial
'Copy requested items
Sheets("Requisition Sheet").Range("B14", Range(B14).End(xlDown).End(xlToRight)).SpecialCells(xlCellTypeVisible).Copy
Workbooks("master").Worksheets("Sheet1").Range("F2").End(xlToRight).Paste
'go to last filled cell in column A
Range("A1").End(xlToRight).Select
Workbooks(Filename).Close True
Filename = Dir
Loop
Application.ScreenUpdating = True
End Sub