Macro to loop through all worksheets except the first two and copy a cell and range into another workbook

Question

I have a master workbook that I have that already looks through all the files in a folder. However, one of the tabs needs to look through all the tabs in a different selected workbook "Data". The workbook has roughly 30 worksheets, and I need to loop through each worksheet except "Investments" and "Funds". If it makes it easier these are the first two tabs in the workbook. I then need to copy cell F9 in each worksheet, paste it into a different workbook "Master" cell "C4", go back to the same worksheet in the "data" workbook and copy range "C16:C136" and paste that into cell "E4" of the "master" workbook. Then it would need to loop to the next worksheet in the "data" workbook and continue the loop. For each new worksheet, I need it to paste one row lower in the "master" file. i.e. the second worksheet would paste in "C5" and "E5".

If it makes it easier I can split this up into two macros. And Just paste all the data from the worksheets into a new blank sheet in the data work book and then I can have another one to copy all of that over into the "master" workbook once done.

Thanks in Advance

Sub ImportInformation()
WorksheetLoop
End Sub

Function WorksheetLoop()

Dim wb As Workbook
Dim ws As Worksheet
Dim foundCell As Range
Dim strFind As String
Dim fRow, fCol As Integer

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

' This allows you to use excel functions by typing wf.<function name>
    Set wf = WorksheetFunction

'Set the name of your output file, I assume its fixed in the Master File
‘Please note that I am running this out of the master file and I want it all in the Noi tab
      Set NOI = ThisWorkbook.Worksheets("NOI")

'Retrieve Target File Path From User
  Set FilePicker = Application.FileDialog(msoFileDialogFolderPicker)

‘This only selects a folder, however I would like it to select a SPECIFIC FILE    
With FilePicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

' initialize the starting cell for the output file
 pasterow = 4

‘I need this to be referring to the file that I choose
For Each ws In wb.Worksheets

If ws.Name <> "Funds" And ws.Name <> "Investments" Then

Next ws

Wb.Worksheets.Range.("F9").Copy
NOI.Range("C" & pasterow).PasteSpecial xlPasteValues, Transpose:=False

   'Get find String
    strFind = NOI.Range("C2").Value

    'Find string in Row 16 of each row of current ACTIVE worksheet
    Set foundCell = wb.Worksheets.Range("A16:IT16").Find(strFind, LookIn:=xlValues)

    'If match cell is found
  If Not foundCell Is Nothing Then

    'Get row and column
    fRow = foundCell.Row
    fCol = foundCell.Column

    'Copy data from active data worksheet “data” and copy over 300 columns (15 years).
‘ This is needed to find what specific date to start at.  This portion works, I just need it to loop through each worksheet.
    wb.Worksheets.active.Range(Cells(fRow + 1, fCol).Address & ":" & Cells(fRow + 1, fCol + 299).Address).Copy

    'Paste in NOI tab of mater portfolio
     NOI.Range("E" & pasterow).PasteSpecial xlPasteValues, Transpose:=False

     wb.Application.CutCopyMode = False

Else

    Call MsgBox("Try Again!” vbExclamation, "Finding String")

End If

Next Ws

    wb.Close SaveChanges:=False
End Function

Answer 1

Please show us your first attempt. Feel free to put in comments like

' I need this to do XXXX here, but I don't know how 

Here are a some hints:

To loop through all sheets in a workbook, use:

For each aSheet in MyWorkbook.Sheets

To skip some specific sheets, say:

If aSheet.Name <> "Investments" And aSheet.Name <> "Funds"

To copy from aSheet to MasterSheet, start by setting the initial destinations:

set rSource = aSheet.range("F9")
set rDestin = MasterSheet.range("C4")

Then in your loop you do the copy:

rDestin.Value = rSource.Value

...and set up the next set of locations

set rSource = rSource.offset(1,0)
set rDestin = rDestin.offset(1,0)

Does that help?

EDIT: Briefly looking at your version, I think this part won't work:

If ws.Name <> "Funds" And ws.Name <> "Investments" Then

Next ws

Don't you want to delete that last line?

EDIT 2: You use this a lot:

wb.Worksheets.<something>

But that does not refer to a specific worksheet. You want to use "ws", like this:

ws.Range("F9")

BIG EDIT:

Step through this version carefully and see how it works:

Sub ImportInformation()
    WorksheetLoop
End Sub

Function WorksheetLoop()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim foundCell As Range
    Dim strFind As String
    Dim fRow, fCol As Integer

    '*** Adding Dims:
    Dim wf, FilePicker
    Dim NOI As Worksheet
    Dim myPath As String
    Dim PasteRow As Long

    'Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    ' This allows you to use excel functions by typing wf.<function name>
    Set wf = WorksheetFunction

    'Set the name of your output file, I assume its fixed in the Master File
    'Please note that I am running this out of the master file and I want it all in the Noi tab
    Set NOI = ThisWorkbook.Worksheets("NOI")


    'Retrieve Target File Path From User
    '    Set FilePicker = Application.FileDialog(msoFileDialogFolderPicker)

    'This only selects a folder, however I would like it to select a SPECIFIC FILE
    '    With FilePicker
    '       .Title = "Select A Target Folder"
    '      .AllowMultiSelect = False
    '     If .Show <> -1 Then GoTo NextCode
    '    myPath = .SelectedItems(1) & "\"
    ' End With


   Dim WorkbookName As Variant
    ' This runs the "Open" dialog box for user to choose a file
    WorkbookName = Application.GetOpenFilename( _
               FileFilter:="Excel Workbooks, *.xl*", Title:="Open Workbook")

    Set wb = Workbooks.Open(WorkbookName)

    ' initialize the starting cell for the output file
    PasteRow = 4

    'I need this to be referring to the file that I choose
    For Each ws In wb.Worksheets

        If ws.Name <> "Funds" And ws.Name <> "Investments" Then

        ' **** Leave this out:   Next ws

        ws.Range("F9").Copy                      '<--- You mean this, not wb.Worksheets.Range.("F9").Copy
        NOI.Range("C" & PasteRow).PasteSpecial xlPasteValues, Transpose:=False

        'Get find String
        strFind = NOI.Range("C2").Value

        'Find string in Row 16 of each row of current ACTIVE worksheet
        Set foundCell = ws.Range("A16:IT16").Find(strFind, LookIn:=xlValues)

        'If match cell is found
        If Not foundCell Is Nothing Then

            'Get row and column
            fRow = foundCell.Row
            fCol = foundCell.Column

            'Copy data from active data worksheet “data” and copy over 300 columns (15 years).
            ' This is needed to find what specific date to start at.  This portion works, I just need it to loop through each worksheet.
            ws.Range(Cells(fRow + 1, fCol).Address & ":" & Cells(fRow + 1, fCol + 299).Address).Copy

            'Paste in NOI tab of mater portfolio
            NOI.Range("E" & PasteRow).PasteSpecial xlPasteValues, Transpose:=False

           '*** Move PasteRow down by one
            PasteRow = PasteRow + 1

            wb.Application.CutCopyMode = False

        Else

            Call MsgBox("Try Again!", vbExclamation, "Finding String")

        End If
    End If
Next ws

    wb.Close SaveChanges:=False
End Function