Auto Transpose macro

[monda24]

Hello there,
I really hope someone can help me with this macro that I tried to create and gave up.
I tried the record macro option and modified the values on the script,but considering the knowledge that I have in excel, it didnot work.
Am trying to create an excel sheet,which, upon one click transposes the 1000 values in 1000 rows(1column) in to single row of 1000 columns.
I cannot paste 2000 values here so am giving an example of 100 values, 50 in one row >then a blank row, then 50.
(so what I actually am looking for is 1000 in one row,blank row>next thousand and so on)
Sometimes, the work we do goes on till 50,000 values to 100000, so it gets difficult.

Example :

Company id

10084410
10110378
11247324
21542065
52p50728
5starf02
5starr07
99034442
aacqst08
aaj04821
aba58774
abc28803
abr85711
abs05863
abukio06
acc10045
acc52500
acchur05
accntl04
accord00
accwci04
ace47732
ace73418
acedde05
acmebc02
aconex08
acr46344
adamsn01
addllc09
ade77627
adtein03
adu74034
adv04788
adv25200
adv60376
adv80105
advfun02
aer23415
aew65323
aff66377
afminc09
africa02
aga55862
agr63845
agrico08
aha80181
ahmoco02
air32040
airint03
airscn04
ajemex09
akfain09
alb64555
albhea04
ald36083
aldrey04
ale04513
algboe09
algosi04
all50435
alp12485
alp58881
alprbs09
alsele04
alsinc05
alterm08
alz55888
amb42163
amclos99
amdjap05
ame16612
ame43768
ame46305
ame67558
ame75681
americ09
amp78733
amplif03
amtekm03
anarco02
anc58283
and43362
andhra08
anesth08
ang24032
ansfmt09
ant06221
anthcn02
anthcn04
anthcn06
anthcn08
anthcn10
anthes03
anthes05
anthes07
anthes09
anthws03
anthws05
anthws07

Result :

first 50 values,(am not able to paste them here in one row)
Insert blank row
Next 50 values,(am not able to paste them here in one row)

Thank you very much in advance.

 

[patel45]

Sub a()
LR = Cells(Rows.Count, "A").End(xlUp).Row
p = 50
drow = 1
dcol = 3
For r = 1 To LR Step p
  Set Rng = Range("A" & r & ":A" & r + p - 1)
  Range(Cells(drow, dcol), Cells(drow, dcol + p - 1)) = Application.WorksheetFunction.Transpose(Rng)
  drow = drow + 2
Next

End Sub

 

[apo]

or..

Private Sub CommandButton1_Click()
    Dim rng As Range, j As Long
    j = 1
    With Sheets("Sheet1")
        For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row Step 50
            Set rng = .Range(Cells(i, 1), Cells(i + 50, 1))
            .Cells(j, 2).Resize(1, rng.Count - 1) = Application.Transpose(rng)
            j = j + 2
        Next i
    End With
End Sub

 

[apo]

or maybe this too..

Sub Test()
   Dim k As Long, l As Long, j As Long
    With Sheets("Sheet1").Range("A1").CurrentRegion
        k = 1: l = 1
        For j = 2 To .Rows.Count Step 50
            .Cells(k, 2).Offset(1).Resize(1, 50) = Application.Transpose(.Offset(l).Resize(51, 1))
            k = k + 2: l = l + 50
        Next j
    End With
End Sub

 

[monda24]

Hey Thank you very much for the replies. I tried the macros but was not able to get the results, may be I need to be more clear. I said 50 in my query because I was not able to post 2000 entries to show that I need 1000 in one row then a blank row and then next 1000 values. I tried to replace the 50 in the code with 1000 but it didnot work. Also, the work we do needs it in a way where I post the values in column A (HEADING BEING COMPANY ID) in sheet 1 and the result should show in sheet 2. for example :

On sheet 1
Row A1 COMPANY ID - Heading

Row A2 to A50000
50,000 VALUES

Result on sheet 2 :
(ROW A1 blank)
A2 TO ALL2 - First thousand values
Blank row (A3 -complete row blank)
A4 TO ALL4 - Next thousand values
Blank row(A5 to ALL5 blank)
A6 TO ALL6 -Next thousand values and so on till 50000 values .please provide your email address so that I can attach the excel file for better understanding..

 

[monda24]

or maybe this too..

Sub Test()
   Dim k As Long, l As Long, j As Long
    With Sheets("Sheet1").Range("A1").CurrentRegion
        k = 1: l = 1
        For j = 2 To .Rows.Count Step 50
            .Cells(k, 2).Offset(1).Resize(1, 50) = Application.Transpose(.Offset(l).Resize(51, 1))
            k = k + 2: l = l + 50
        Next j
    End With
End Sub

Hey Thank you very much for the replies. I tried the macros but was not able to get the results, may be I need to be more clear. I said 50 in my query because I was not able to post 2000 entries to show that I need 1000 in one row then a blank row and then next 1000 values. I tried to replace the 50 in the code with 1000 but it didnot work. Also, the work we do needs it in a way where I post the values in column A (HEADING BEING COMPANY ID) in sheet 1 and the result should show in sheet 2. for example :

On sheet 1
Row A1 COMPANY ID - Heading

Row A2 to A50000
50,000 VALUES

Result on sheet 2 :
(ROW A1 blank)
A2 TO ALL2 - First thousand values
Blank row (A3 -complete row blank)
A4 TO ALL4 - Next thousand values
Blank row(A5 to ALL5 blank)
A6 TO ALL6 -Next thousand values and so on till 50000 values .please provide your email address so that I can attach the excel file for better understanding..

 

[monda24]

Hey Thank you very much for the replies. I tried the macros but was not able to get the results, may be I need to be more clear. I said 50 in my query because I was not able to post 2000 entries to show that I need 1000 in one row then a blank row and then next 1000 values. I tried to replace the 50 in the code with 1000 but it didnot work. Also, the work we do needs it in a way where I post the values in column A (HEADING BEING COMPANY ID) in sheet 1 and the result should show in sheet 2. for example :

On sheet 1
Row A1 COMPANY ID - Heading

Row A2 to A50000
50,000 VALUES

Result on sheet 2 :
(ROW A1 blank)
A2 TO ALL2 - First thousand values
Blank row (A3 -complete row blank)
A4 TO ALL4 - Next thousand values
Blank row(A5 to ALL5 blank)
A6 TO ALL6 -Next thousand values and so on till 50000 values .please provide your email address so that I can attach the excel file for better understanding..

 

[patel45]

Sub a()
LR = Cells(Rows.Count, "A").End(xlUp).Row
p = 1000 ' you can change this value
drow = 1
dcol = 3
For r = 1 To LR Step p
  Set Rng = Range("A" & r & ":A" & r + p - 1)
  Range(Cells(drow, dcol), Cells(drow, dcol + p - 1)) = Application.WorksheetFunction.Transpose(Rng)
  drow = drow + 2
Next

End Sub

 

[oldbrewer]

you are limited to a certain number of cells in a row

 

[apo]

Mine does what you want too..

may be I need to be more clear

Nope.. your initial post was very clear..

Both mine and patel45's was using your example of 50 per row to show the method.. only minor changes in both needed to make it fit your 'real life' situation..

Using below code.. I get results out to column 'ALL' (starting in row 2 of sheet2 and then every second row after that)..

Private Sub CommandButton1_Click()
    Dim rng As Range, j As Long
    j = 2
    With Sheets("Sheet1")
        For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row Step 1000
            Set rng = .Range(Cells(i, 1), Cells(i + 1000, 1))
            Sheets("Sheet2").Cells(j, 1).Resize(1, rng.Count - 1) = Application.Transpose(rng)
            j = j + 2
        Next i
    End With
End Sub