Макрос для циклического перебора всех листов, кроме первых двух, копирования ячейки и выбора диапазона в другой книге.

Question

У меня есть основная рабочая книга, которая уже просматривает все файлы в папке. Однако одна из вкладок должна просматривать все вкладки в другой выбранной книге «Данные». Рабочая книга содержит около 30 рабочих листов, и мне нужно просмотреть все рабочие листы, кроме «Инвестиции» и «Фонды». Если это облегчает, это первые две вкладки в рабочей книге. Затем мне нужно скопировать ячейку F9 на каждом листе, вставить ее в отдельную книгу «Основная», ячейка «C4», вернуться на тот же лист в книге «Данные» и скопировать диапазон «C16: C136» и вставить его в ячейку. «Е4» из «мастер» рабочей тетради. Затем он должен был бы вернуться к следующему рабочему листу в книге данных и продолжить цикл. Для каждого нового листа мне нужно вставить одну строку ниже в «мастер» файл. то есть второй лист будет вставлен в «C5» и «E5».

Если мне будет проще, я могу разделить это на два макроса. И просто вставьте все данные из рабочих листов в новый чистый лист в рабочей книге данных, и тогда у меня будет еще один, чтобы скопировать все это в «основную» рабочую книгу, как только это будет сделано.

Заранее спасибо

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

Пожалуйста, покажите нам свою первую попытку. Не стесняйтесь добавлять комментарии, как

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

Вот несколько подсказок:

Чтобы просмотреть все листы в книге, используйте:

For each aSheet in MyWorkbook.Sheets

Чтобы пропустить некоторые конкретные листы, скажите:

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

Чтобы скопировать из aSheet в MasterSheet, начните с установки начальных адресатов:

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

Затем в вашем цикле вы делаете копию:

rDestin.Value = rSource.Value

... и настройте следующий набор местоположений

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

Это помогает?

РЕДАКТИРОВАТЬ: Вкратце глядя на вашу версию, я думаю, что эта часть не будет работать:

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

Next ws

Разве вы не хотите удалить эту последнюю строку?

РЕДАКТИРОВАТЬ 2: Вы часто используете это:

wb.Worksheets.<something>

Но это не относится к конкретному рабочему листу. Вы хотите использовать "ws", например так:

ws.Range("F9")

БОЛЬШОЕ РЕДАКТИРОВАНИЕ:

Внимательно изучите эту версию и посмотрите, как она работает:

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