基于单元格值循环遍历另一个工作簿中的范围

Question

I use the code below to loop through a range.

I need to change the sourceRange to a range in the Analysis v1 workbook.

In the Summary sheet of that workbook in cells B2 and B3 there are names of column headers in another sheet in that workbook called Data. The headers in the Data sheet are in row 2.

I would like to find the B2 and B3 column headers then loop through each column.

Option Explicit

Public Sub Process()

    Dim targetWorkbook As Workbook
    Dim summarySheet As Worksheet
    Dim sourceRange As Range
    Dim cell As Range

    ' Customize this settings
    Set targetWorkbook = Workbooks("Analysis v1.xlsm")
    Set summarySheet = ThisWorkbook.Worksheets("Summary")
    Set sourceRange = summarySheet.Range("Q3:Q5")

    Application.ScreenUpdating = False

    ' Loop through each cell in source range
    For Each cell In sourceRange.Cells
        ' Validate that cell has a value
        If cell.Value <> vbNullString Then

            summarySheet.Range("F3").Value = cell.Value
            ' Execute procedure to create new sheet
            CreateNewSheet
        End If
    Next cell

    Application.ScreenUpdating = True
End Sub

Answer 1

Hi please check the following codes for your ref. Just show method of how to add / save a workbook.

Sub aa()
Dim targetWorkbook As Workbook
Dim summarySheet As Worksheet
Dim sourceRange As Range
Dim cell As Range

' Customize this settings
'Set targetWorkbook = Workbooks("Analysis v1.xlsm")
Set summarySheet = ThisWorkbook.Worksheets("Summary")
Set sourceRange = summarySheet.Range("Q3:Q5")

Application.ScreenUpdating = False

'not very clear for your logic ******
 'Loop through each cell in source range
For Each cell In sourceRange.Cells
    ' Validate that cell has a value
    If cell.Value <> vbNullString Then

        summarySheet.Range("F3").Value = cell.Value
        ' Execute procedure to create new sheet
        End If
Next cell
' *************************
'Here is the demo of how to copy and save to a new workbook.
Set targetWorkbook = Workbooks.Add
Dim fName As String
fName = "Analysis v1.xlsm"

targetWorkbook.Sheets(1).Range("A1") = summarySheet.Range("F3").Value
Application.DisplayAlerts = False
On Error Resume Next
targetWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & fName, FileFormat:=52
targetWorkbook.Close SaveChanges:=True
Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub