以下代码没有解决与*命名范围有关的“子问题”，因为我不理解那部分。
然而，下面的代码有点短，甚至更容易阅读。此外，在速度方面也做了一些小的改进：
Option Explicit
Public Sub tmpSO()
Dim WS As Worksheet
Dim X As Long, Y As Long, Z As Long
X = 12
Z = 0
Set WS = ThisWorkbook.Worksheets("Schedule")
With Worksheets("Project Status")
For Y = 4 To WS.Cells(WS.Rows.Count, 2).End(xlUp).Row
If WS.Cells(Y, 2).Font.Bold And WS.Cells(Y, 2).Value2 < 1 Then
WS.Cells(Y, 2).Offset(0, 1).Copy Destination:=.Cells(X, 3)
WS.Cells(Y, 2).Offset(0, 3).Copy Destination:=.Cells(X, 6)
WS.Cells(Y, 2).Offset(0, 4).Copy Destination:=.Cells(X, 7)
WS.Cells(Y, 2).Offset(0, 0).Copy Destination:=.Cells(X, 8)
X = X + 1
Z = Z + 1
' Else
' Y = Y + 1
End If
If Z = 7 Then Exit For
Next Y
End With
End Sub
也许您可以详细说明一下为什么要使用命名范围，以及您希望用它们实现什么，而上述代码无法按原样实现。
更新：
Miqi180 让我意识到，通过直接引用单元格来避免 Offset 时可能存在性能差异。因此，我在我的系统（Office 2016，64 位）上进行了一个小型性能测试来测试这个假设。显然，存在约 14% 的主要性能差异（比较使用 Offset 的 10 次迭代的平均值和避免它的另外 10 次迭代）。
这是我用来测试速度差异的代码。如果您认为此设置有缺陷，请告诉我：
Option Explicit
' Test whether you are using the 64-bit version of Office.
#If Win64 Then
Declare PtrSafe Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#End If
Public Sub SpeedTestDirect()
Dim i As Long
Dim ws As Worksheet
Dim dttStart As Date
Dim startTime As Currency, endTime As Currency
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Set ws = ThisWorkbook.Worksheets(1)
ws.Cells.Delete
dttStart = Now
getTickCount startTime
For i = 1 To 1000000
ws.Cells(i, 1).Value2 = 1
ws.Cells(i, 2).Value2 = 1
ws.Cells(i, 3).Value2 = 1
ws.Cells(i, 4).Value2 = 1
ws.Cells(i, 5).Value2 = 1
ws.Cells(i, 6).Value2 = 1
Next i
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
getTickCount endTime
Debug.Print "Runtime: " & endTime - startTime, Format(Now - dttStart, "hh:mm:ss")
End Sub
Public Sub SpeedTestUsingOffset()
Dim i As Long
Dim ws As Worksheet
Dim dttStart As Date
Dim startTime As Currency, endTime As Currency
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Set ws = ThisWorkbook.Worksheets(1)
ws.Cells.Delete
dttStart = Now
getTickCount startTime
For i = 1 To 1000000
ws.Cells(i, 1).Offset(0, 0).Value2 = 1
ws.Cells(i, 1).Offset(0, 1).Value2 = 1
ws.Cells(i, 1).Offset(0, 2).Value2 = 1
ws.Cells(i, 1).Offset(0, 3).Value2 = 1
ws.Cells(i, 1).Offset(0, 4).Value2 = 1
ws.Cells(i, 1).Offset(0, 5).Value2 = 1
Next i
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
getTickCount endTime
Debug.Print "Runtime: " & endTime - startTime, Format(Now - dttStart, "hh:mm:ss")
End Sub
基于这一发现，改进后的代码应该是（感谢 Miqi180）：
Public Sub tmpSO()
Dim WS As Worksheet
Dim X As Long, Y As Long, Z As Long
X = 12
Z = 0
Set WS = ThisWorkbook.Worksheets("Schedule")
With Worksheets("Project Status")
For Y = 4 To WS.Cells(WS.Rows.Count, 2).End(xlUp).Row
If WS.Cells(Y, 2).Font.Bold And WS.Cells(Y, 2).Value2 < 1 Then
WS.Cells(Y, 3).Copy Destination:=.Cells(X, 3)
WS.Cells(Y, 5).Copy Destination:=.Cells(X, 6)
WS.Cells(Y, 6).Copy Destination:=.Cells(X, 7)
WS.Cells(Y, 2).Copy Destination:=.Cells(X, 8)
X = X + 1
Z = Z + 1
' Else
' Y = Y + 1
End If
If Z = 7 Then Exit For
Next Y
End With
End Sub
然而，应该注意的是，通过转移到 (1) 仅复制值/直接使用 .Cells(X, 3).Value2 = WS.Cells(Y, 2).Value2（例如）和 (2) 进一步使用数组来代替，速度仍然可以大大提高。
当然这还不包括Application.ScreenUpdating = False、Application.Calculation = xlCalculationManual、Application.EnableEvents = False等标准建议。