VBA to copy unhidden values from column to row and speed up macro

[jwilson28]

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