VBA code for adding a specific worksheet condition within a subfolder consolidation macro

Dedonovan

New Member
Joined
Aug 22, 2013
Messages
7
Hello all,
The issue is the I want to put the condition here in my the code that only copies the desired cells if the sheet is named specifically such as "Jan", if not named as this the worksheet should not be used. The current code I am using was posted on this site in 2009: http://www.mrexcel.com/forum/excel-...ns-copy-specified-cells-all-files-folder.html

My modified code is: Thanks in advance for all the help!
Option Explicit
Public strSourceFldr As String
Public EachFile As Object
Public objFSO As Object
Public objFolder As Object
Public objFile As Object
Public strSheetName As String
Public strSrcCell1 As String
Public strSrcCell2 As String
Public strSrcCell3 As String
Public strSrcCell4 As String
Public intStartCell As Integer
Sub DataCopy()
strSourceFldr = "C:\Users\user\DB\Monthly Reports\" 'this is the folder path
strSheetName = ("Jan") 'This is the sheet name I want to pull specific data from
strSrcCell1 = "A41" 'Data to copy
strSrcCell2 = "A42"
strSrcCell3 = "A43"
strSrcCell4 = "A44"
intStartCell = 2 'this is the row number to start on
Set objFSO = CreateObject("Scripting.Filesystemobject")
Set objFolder = objFSO.GetFolder(strSourceFldr)
For Each EachFile In objFolder.Files
If LCase(objFSO.GetExtensionName(EachFile)) = "xlsx" Then
ProcessFile EachFile
End If
Next
ProcessSubFolder objFSO.GetFolder(strSourceFldr)
End Sub
Sub ProcessFile(ByRef ThisFile As Object)
Dim Cell1, Cell2, Cell3, Cell4
Set objFile = objFSO.GetFile(ThisFile)
Workbooks.Open ThisFile
Cell1 = Range(strSrcCell1).Value
Cell2 = Range(strSrcCell2).Value
Cell3 = Range(strSrcCell3).Value
Cell4 = Range(strSrcCell4).Value
ActiveWorkbook.Close
Worksheets(1).Cells(intStartCell, 1) = ThisFile.Name 'intStartCell is the starting cell (#,#) indicate position
Worksheets(1).Cells(intStartCell + 1, 2) = Cell1
Worksheets(1).Cells(intStartCell + 2, 2) = Cell2
Worksheets(1).Cells(intStartCell + 3, 2) = Cell3
Worksheets(1).Cells(intStartCell + 4, 2) = Cell4
'Worksheets(1).Cells(intStartCell, 6) = ThisFile.Path 'this is the path of where the data comes from
intStartCell = intStartCell + 10 'This is the number of rows between inserted data. Must be bigger than reqested range
End Sub
Sub ProcessSubFolder(ByRef ThisFolder As Object)
Dim SubFolder
For Each SubFolder In ThisFolder.SubFolders
Set objFolder = objFSO.GetFolder(SubFolder.Path)
For Each EachFile In objFolder.Files
If LCase(objFSO.GetExtensionName(EachFile)) = "xlsx" Then
ProcessFile EachFile
End If
Next
ProcessSubFolder objFolder
Next
'Empty Row delete code
Dim i As Long
Sheets("Summary").Select
Range("A1:M500").Select
'We turn off calculation and screenupdating to speed up the macro.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
'We work backwards because we are deleting rows.
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
Range("A1").Select
End With
End Sub
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Update: I have figured out what is going on I just don't know how to fix it. The problem is the above code does not pull data from the specified worksheet (code piece is highlighted in red) instead the code pulls which ever worksheet the file was saved on last. So now the question becomes is there a different syntax I should use to have it search a specific worksheet?
 
Upvote 0

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top