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