CODEWITHSUNDEEP
excelvba
Rominall
Rominall

Reputation: 19

Excel, trying to copy, transpose X number of cells

I have a big list (vertical) of members with 61 datafields. I need to cooy/transpose each member to another sheet.

Sample Data:

Name:
Last Name:
Address:
Membership Date:
Maiden Name:
...
61 items

The file I got repeats the data field titles for each member so the file is 2 columns wide by 50k long

I want to copy just column b to another sheet.

So this is what I have and I don't know where to go next.

Sub CopyTranspose()
    Dim rng As Range
    Dim i As Long

    Set rng = ThisWorkbook.ActiveSheet.Range("B1:B51000")
    With rng

        ' Loop through all cells of the range
        For i = 1 To 51000 Step 1
            'Select member data fields
            Range("B2:B61").Select

            ' Copy and transpose
            Selection.Copy
            Sheets("Sheet1").Select
            Range("A2").Select
            Range("A2").Select
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
              False, Transpose:=True
        Next i
    End With
End Sub

I know it's not right, I know I need to add 61 to everything for each iteration and when pasting go to last blank row. I assume I add another variable for account for I-61 + x number of iterations. Then I do something on the paste side to jump to last empty cell?

Thanks for any assistance.

Upvotes: 0

Views: 142

Answers (2)

Wolfie
Wolfie

Reputation: 30101

It would be much quicker to use an array to transpose the data than to use copy/paste. Given the size of your data set, I assume a fast solution is preferable... 

' Get last row in copy-from sheet
Dim lastRow as Long
lastRow = Sheets("DataSheet").Range("A" & Rows.Count).End(xlUp).Row
' Loop down that sheet, copying blocks of 61 rows
Dim i as Long
Dim dataArray as Variant
For i = 1 To lastRow Step 61
    ' Assign data to an array
    dataArray = Sheets("DataSheet").Range("B" & i & ":B" & i + 60)
    ' Stick the values of that transposed array into the summary sheet
    With Sheets("TransposedSheet")
        .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1).value = Application.Transpose(dataArray)
    End With
Next i

I mentioned speed. For comparison, I implemented my method, acsql's copy/paste method, and the copy/paste method with Application.ScreenUpdating = False set. The last option is a well known way to speed up macros. Results for 4000 rows of just single digits in column B:

  • Array method: 0.01171875 s
  • Copy and paste method (screen updating true) 0.7890625 s
  • Copy and paste method (screen updating false) 0.3671875 s

So use arrays!

Upvotes: 2

acvbasql
acvbasql

Reputation: 109

This should work assuming you're wanting each datapoint as a column & a new row for each person?

lRow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To lRow Step 61

    iStart = i
    iEnd = i + 60

    Sheets("Data").Range("B" & iStart & ":B" & iEnd).Copy

    Sheets("Sheet1").Range("A" & Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Next i

Upvotes: 0

Related Questions