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

Question

我使用下面的代码循环一个范围。

我需要将 sourceRange 更改为 Analysis v1 工作簿中的范围。

在单元格 B2 和 B3 中该工作簿的摘要表中，该工作簿的另一个表中的列标题名称称为数据。 数据表中的标题位于第 2 行。

我想找到 B2 和 B3 列标题，然后遍历每一列。

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

嗨，请检查以下代码以获取您的参考。 只需显示如何添加/保存工作簿的方法。

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