1

我有不定数量的多个工作表，我试图将单个列范围（即向下的“C4”）从每个工作表转换为单个摘要工作表。所有工作表的列范围都相同。我从其他帖子改编的代码让我很接近，但是当我从每个工作表中转置列时，它似乎只将它们转置到一行（“F4”）。有人可以尝试看看我错过了什么吗？非常感激！！这是我一直在使用的代码：

    Sub UpdateSummary()

    Dim rng3 As Range, sh As Worksheet, lastRow As Long

    'the "sample" work sheet has the total # of rows; used to count # rows
    'which will be needed from each of the other worksheets

    lastRow = Worksheet("sample").Range("J3").End(xlDown).Row

    'the workbook has multiple worksheets numbered from 1 to n

    Sheets("summary").Activate
    For Each sh In Worksheets
         If sh.Name <> "summary" _
         And sh.Name <> "sample" Then

         'if i don't add the +1 it's short by 1
          Set rng3 = sh.Range("C4:C" & lastRow + 1)

           rng3.Copy

           'using Transpose so for each sh its range goes into the summary as 
           'rows (starts from F4 because the top 3 rows are headers)
           Worksheets("summary").Range("F4").PasteSpecial Transpose:=True
         End If
       Next sh
    End Sub

在考虑这一点时......我认为它需要的部分内容是计算将复制/转置范围的工作表的数量 - 并将该工作表的总数用作数据将被转置的行数？

我明白了...我需要通过偏移来重置目标范围。这是有效的代码：

    Sub CalcSummary()
      'vba to calculate summary
      'for all worksheets except sample and summary
      'select range to copy values
      'transpose values onto summary sheet

      Dim rng3 As Range
      Dim sh As Worksheet
      Dim cases As Long
      Dim items As Long
      Dim trng As Range

      cases = Worksheets("sample").Range("A3").End(xlUp).Row
      items = Worksheets("sample").Range("J3").End(xlDown).Row
      Set trng = Worksheets("summary").Range("F4")

      Sheets("summary").Activate
      For Each sh In Worksheets

        If sh.Name <> "summary" _
        And sh.Name <> "sample" Then
          Set rng3 = sh.Range("C4:C" & items + 1)
          rng3.Copy

            With trng
              .PasteSpecial Transpose:=True
            End With
          Set trng = trng.Offset(1, 0)
        End If
      Next sh
      MsgBox "Summary sheet updated successfully."

    End Sub

希望这对其他需要做类似事情的人有所帮助；）感谢所有可能试图为我重写代码的人。

4

0 回答 0