从一张表中复制和转置数据并创建一个新表，然后将数据粘贴到新表中

Question

我有某种格式的数据，我一直在尝试复制行值并使用 VBA 转置它们。

我可以让它在一张纸上工作，但不是多张。

用于单张工作表的代码

Sub transform()


Dim wss As Worksheet
Dim rng As Range
Dim i As Integer
Dim j As Integer
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet2")







Cells.MergeCells = False

ws.Range(ws.Cells(1, 271), ws.Cells(9999, 350)).ClearFormats

'Loop to transpose all data

For i = 2 To 62
    ws("Sheet1").Range(Cells(i, 1), Cells(i, 215)).Copy
    ws.Cells(5, i).PasteSpecial transpose:=True
Next i

end sub

我已经完成了为第二部分尝试实现的代码编写代码。

For Each wss In ws
        For i = 1 To 62
             ws.Range(Cells(i, 1), Cells(i, 215)).Copy
             Sheets.Add After:=ActiveSheet
             ws.Cells(5, i).PasteSpecial transpose:=True
        Next i
Next wss

我现在想遍历工作簿中的所有工作表，并将每个工作表中的单元格复制并转置到自己的新工作表中，谁能提供一些指导？

Answer 1

我认为这可能是你想要做的：

Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim i As Integer

For Each sourceSheet In wb.Sheets
    ' Don't transpose transposed sheets
    If Left(sourceSheet.Name, 3) <> "TX_" Then
        ' Add the new sheet
        Set targetSheet = wb.Sheets.Add After:=sourceSheet
        ' Flag the name so it won't get transposed
        targetSheet.Name = "TX_" & sourceSheet.Name
        ' Copy source to target
        For i = 1 To 62
             sourceSheet.Range(sourceSheet.Cells(i, 1), sourceSheet.Cells(i, 215)).Copy
             targetSheet.Cells(5, i).PasteSpecial transpose:=True
        Next i

    End If

Next sourceSheet