Question

Sub sbCopyRangeToAnotherSheet()
   Dim col As Integer
   col = 1
   For Each wks In Worksheets
      If (wks.Name <> "Sheet23") Then
          wks.Range("A1:z29").Copy Destination:=Sheets("Sheet23").Cells(1, col)
          col = col + 25
      End If
   Next wks
End Sub

当我使用上面的代码时，它只会将所有内容添加到彼此之后。但我需要对其进行转置，并将每张纸张显示在另一张纸张下方，而不是彼此相邻。我需要做些什么才能做到这一点？

Answer 1

试试这个，让我知道：

Option Explicit

Sub sbCopyRangeToAnotherSheet()

    Dim rngRange        As Range
    Dim rnglasRow       As Long
    Dim wksDestination  As Worksheet
    Dim wks             As Worksheet

    Set wksDestination = Sheets("Sheet23")

    For Each wks In Worksheets
        If (wks.Name <> "Sheet23") Then
            Set rngRange = wksDestination.Cells.Find("*", wksDestination.Cells(1, 1), xlFormulas, xlWhole, xlByRows, xlPrevious)
            If Not rngRange Is Nothing Then
                rnglasRow = rngRange.Row
            Else
                rnglasRow = 1
            End If
            wks.Range("A1:z29").Copy Destination:=Sheets("Sheet23").Cells(rnglasRow + 2, 1)
        End If
    Next wks

    'Release Memory
    Set rngRange = Nothing
    Set wksDestination = Nothing
    Set wks = Nothing

End Sub

将多张纸张转置为单张纸张

1 个答案: