Crazyness
Crazyness

Reputation: 15

Copy & Transpose Data from one sheet & create a new sheet then paste the data into the new sheet

I have data in a certain format & I have been trying to copy the row values and transpose them using VBA.

I can get this to work for 1 sheet but not multiple.

Code used for a single sheet

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

I have gotten this far with making the code for the what I am trying to achieve with the second part.

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

I want to now loop through all the sheets in the workbook and copy and transpose cells from each sheet into its own new sheet can anyone provide some guidance?

Upvotes: 1

Views: 304

Answers (1)

StoneGiant
StoneGiant

Reputation: 1497

I think this might be what you're trying to do:

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

Upvotes: 1

Related Questions