Count cells then transpose data in new rows below

Question

Pretty new to this. Need some help!

I have 61 separate sheets within the same workbook. Row 8 on every worksheet has the same type of data, but varies in column length from sheet-to-sheet (left to right).

I'd like to write a VBA script that would do the following:

Begin on Column A, Row 8.
Count the number of cells with data in Row 8 (left to right).
Insert rows below based on the number of cells counted.
Transpose the data from Row 8 to the newly inserted rows directly below. Ideally, I'd like to keep the first piece of data (column A, Row 8) where it is and paste the rest below that.

I've got some code written, but just can't seem to get it completed.

    Sub Macro3()
Dim example As Range
Set example = Range("A1")

example.Rows(8).Select

usedRangeLastColNum = ActiveSheet.UsedRange.Columns.Count
MsgBox usedRangeLastColNum

example.EntireRow(9).Insert


    End Sub

I don't need a message box to pop up. I just used that to make sure my code was getting the right number count.

I think I've gotten pretty far based on the fact I am completely new to this.

Thanks so much!

E

check out [this question](https://stackoverflow.com/questions/13174916/transpose-a-range-in-vba) for transposing ranges. in that solution they copy the range into an array first. — Marcucciboy2, Jun 05 '18 at 17:33

JvdV · Accepted Answer · 2018-06-05T18:24:39.957

2

Maybe this is proficient? Should do what you want

EDITED

Sub LoopSheets()

Dim WS As Worksheet
Dim CL As Long, X As Long

For Each WS In ThisWorkbook.Sheets
    CL = WS.Cells(8, Columns.Count).End(xlToLeft).Column
    If CL > 1 Then
        WS.Cells(9, 1).EntireRow.Resize(CL - 1).Insert Shift:=xlDown
        For X = 2 To CL
            WS.Cells(7 + X, 1) = WS.Cells(8, X)
            WS.Cells(8, X).ClearContents
        Next X
    End If
Next WS

End Sub

edited Jun 05 '18 at 18:24

answered Jun 05 '18 at 17:38

JvdV

70,606
8
39
70

Thanks so much! It did exactly what I was looking for. My description wasn't exactly correct on my end. I'd like the data from Row 8 (minus the data from column A) to be deleted after transposing. Also, the included cells below should be entire rows so that the rest of the spreadsheet isn't compromised from only one column behind pushed down. OTHER THAN THAT IT IS PERFECT!!!! – Eric Fletcher Jun 05 '18 at 17:49
Your welcome, answer is edited now. Last question ("compromised from only one column behind pushed down") I don't fully understand. – JvdV Jun 05 '18 at 17:52
2

@JvdV you are overwriting the values in "A9" down, since you haven't inserted rows beforehand. – BigBen Jun 05 '18 at 18:08
Thanks, I now see what Eric meant. Will edit the code accordingly. Thank you @BigBen – JvdV Jun 05 '18 at 18:12
This is it. Exactly what I was looking for. Thank you SO MUCH both of you. I wish I had enough Karma to upvote this solution. For now I have marked it solved. – Eric Fletcher Jun 05 '18 at 18:27

urdearboy · Answer 2 · 2018-06-05T18:12:46.757

1

This will transpose your values in Row 8 (starting at cell A9) and shift all data below down. (The shift down will equal the length of your range in Row 8)

You should also disable the screen from updating while running the loop

Sub Transpose()

Dim WS As Worksheet
Dim LCol As Long
Dim CopyRange As Range

Application.ScreenUpdating = False

For Each WS In Worksheets
    LCol = WS.Cells(8, WS.Columns.Count).End(xlToLeft).Column 'Determine Last Column
    WS.Range("A9").EntireRow.Resize(LCol).Insert Shift:=xlDown 'Insert new cells to accommodate space for transpose
    Set CopyRange = Range(Cells(8, 1), Cells(8, LCol)) 'dynamic copy range
    CopyRange.Copy
    WS.Range("A9").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, , True
‘Add line to delete row 8 here
Next WS

Application.ScreenUpdating = False

End Sub

edited Jun 05 '18 at 18:12

answered Jun 05 '18 at 17:44

urdearboy

14,439
5
28
58

Although this is a way to do it (always good to have multiple ways of doing things), it is A: way slower and B: also copies the first column's value. – JvdV Jun 05 '18 at 17:51
@urdearboy I think you insert 1 too many rows with `WS.Range("A9").EntireRow.Resize(LCol).Insert Shift:=xlDown`. – BigBen Jun 05 '18 at 18:10
Something strange is happening. For the first worksheet, the data that was transposed matches exactly the data originally found in the ROW. However, as I move to another worksheet the transposed data is incorrect. It is not an exact copy of the row data found in the specific worksheet. It seems to be combining / referencing data outside of the specific worksheet. Weird! – Eric Fletcher Jun 05 '18 at 18:13
Updated - was fine before I tried to adjust to another comment. Since OP wants to delete row 8, I’m okay with it copying the first cell. Reverted back to my original answer ~ – urdearboy Jun 05 '18 at 18:13

score 0 · Answer 3 · answered Jun 05 '18 at 20:44

Range from A2 to A8 is our array that we are going to transpose to range D2 to J2.

       A    B    C    D    E    F    G    H    I    J
1
2      1              1    2    3    4    5    6    7
3      2
4      3
5      4
6      5
7      6
8      7

Here is the code:

Sub transpose()
 Dim r() As Long 'Array where values are going to be stored
 Dim i as integer 'Row number

 For i = 2 To 8
  'add the values of an array
   ReDim Preserve r(0 to 6)
   r(i-2) = CellS(i,1)

   'Transpose the values of that array
   Cells(2,i+2) = r(i-2)
 Next i
End Sub

Count cells then transpose data in new rows below

3 Answers3