将多个工作表中的相同单列范围转换为单个工作表

时间:2013-05-31 01:33:14

标签: transpose

我有一个无限数量的多个工作表,我试图将每个工作表的单个列范围(即“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

希望这对任何需要做类似事情的人都有帮助;)并感谢所有可能为我重写代码的人。

0 个答案:

没有答案