Excel VBA - 循环工作表，复制单元格，引用到第一个工作表

Question

我正在设置一个计划工作簿，我的公司将在其中有单独的工作表（所有设置都相同）计划各个项目。这些工作表将具有某些单元格（每张工作表上相同），然后主主进度表将引用这些单元格，这是子项目进度表的高点的汇编。这可能吗？我是 VBA 编码的新手，所以请善待 :)

我目前编写了一些代码来复制并粘贴到目标工作表上 B 列的最后一个空单元格中，但是这段代码无论如何都不起作用（还没有弄清楚原因）。但理想情况下，我希望引用单元格，而不是复制+粘贴，以避免当事情发生变化时工作表之间的沟通不畅。粘贴在下面的代码以供参考，除了其他参考问题外，还希望能帮助解决此问题。

Sub LoopAndInsert()

Dim ws As Worksheet
Dim target As Worksheet
    Set target = Worksheets("Global Schedule Gantt") 'sheet we're copying to
    
    For Each ws In ThisWorkbook.Worksheets  'loop through all worksheets
    
     If ws.Name <> target.Name Then   'if not the target sheet then...
         'copy range into the next blank row in column C
         ws.Range("CopyToGlobal").Copy target.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
     End If
     
Next ws
End Sub

Answer 1

看看这是否是你所追求的。我假设您希望主表中的单元格只是引用（例如=Sheet1!$A$1），而不仅仅是具有值。

编辑：根据新信息更改代码。

Sub LoopAndInsert()

Application.ScreenUpdating = False 'I would set these 2 off with this.
Application.Calculation = xlCalculationManual

Dim ws As Worksheet, target As Worksheet
Dim lrow As Long, lrowMaster As Long, i As Long, j As Long

Set target = Worksheets("Global Schedule Gantt") 'sheet we're copying to
lrowMaster = target.Range("B" & Rows.Count).End(xlUp).Row
    
For Each ws In ThisWorkbook.Worksheets  'loop through all worksheets
    If ws.Name <> target.Name Then   'if not the target sheet then...
        For i = 14 To 42
            Select Case i
                Case 14, 15, 16, 18, 23, 25, 26, 29, 31, 32, 33, 35, 36, 41, 42
                lrowMaster = lrowMaster + 1 'Move down to next available row
                For j = 3 To 9
                    target.Cells(lrowMaster, j - 1).Formula = "='" & ws.Name & "'!" & ws.Cells(i, j).Address
                Next j
            End Select
        Next i
    End If
Next ws

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Answer 2

复制非连续（多区域）范围的单元格引用

• 调整常量部分中的值。

守则

Option Explicit

Sub LoopAndInsert()
    
    Const dstName As String = "Global Schedule Gantt"
    Const dstCol As String = "B"
    Const srcRange As String = "CopyToGlobal"
    ' Or:
    'Const srcRange as String _
        = "C14:I16,C18:I18,C23:I23,C25:I26,C29:I29,C31:I33,C35:I36,C41:I42"
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim cel As Range
    With wb.Worksheets(dstName)
        Set cel = .Cells(.Rows.Count, dstCol).End(xlUp).Offset(1)
    End With
    
    Dim src As Worksheet
    Dim sRng As Range
    Dim dRng As Range
    For Each src In wb.Worksheets
        If src.Name <> dstName Then
            For Each sRng In src.Range(srcRange).Areas
                Set dRng = cel.Resize(sRng.Rows.Count, sRng.Columns.Count)
                    dRng.Formula _
                        = "='" & src.Name & "'!" & sRng.Cells(1).Address(0, 0)
                Set cel = cel.Offset(sRng.Rows.Count)
            Next sRng
        End If
    Next src

End Sub