Macro for transposing data

[JoelBrown]

Hi again,

I require a macro to move multiple lines of data into a table style format.

The macro is required to keep the first three cells of the row as they are and then repeat down for 41 further lines. Then the next 11 cells to remain as they are, then every 11 cells for the next 41 times to be moved under the first 11 cells.

The link at the bottom shows the data before and after. There are a lot of blanks cells in the data, these are there as I have to keep the data in this format to upload to a separate system.

If it is easier, I require a macro to do the following:

A1:C1 - Stay as they are and repeat down to A42:C42
D1:N1 - Stay as they are
O1:Y1 - D2:N2
Z1:AJ1 - D3:N3
AK1:AU1 - D4:N4
AV1:BF1 - D5:N5
BG1:BQ1 - D6:N6
BR1:CB1 - D7:N7
CC1:CM1 - D8:N8
CN1:CX1 - D9:N9
CY1:DI1 - D10:N10
DJ1:DT1 - D11:N11
DU1:EE1 - D12:N12
EF1:EP1 - D13:N13
EQ1:FA1 - D14:N14
FB1:FL1 - D15:N15
FM1:FW1 - D16:N16
FX1:GH1 - D17:N17
GI1:GS1 - D18:N18
GT1:HD1 - D19:N19
HE1:HO1 - D20:N20
HP1:HZ1 - D21:N21
IA1:IK1 - D22:N22
IL1:IV1 - D23:N23
IW1:JG1 - D24:N24
JH1:JR1 - D25:N25
JS1:KC1 - D26:N26
KD1:KN1 - D27:N27
KO1:KY1 - D28:N28
KZ1:LJ1 - D29:N29
LK1:LU1 - D30:N30
LV1:MF1 - D31:N31
MG1:MQ1 - D32:N32
MR1:NB1 - D33:N33
NC1:NM1 - D34:N34
NN1:NX1 - D35:N35
NY1:OI1 - D36:N36
OJ1:OT1 - D37:N37
OU1:PE1 - D38:N38
PF1:PP1 - D39:N39
PQ1:PA1 - D40:N40
QB1:QL1 - D41:N41
QM1:QW1 - D42:N42




https://www.dropbox.com/sh/2qyh5y8f91hajk5/AABPvkj0D2ssP7OLZNzb6yJFa?dl=0

Any help would be of HUGEEEE assistance.

Many thanks,

Joel

 

[Fluff]

How about

Sub CopyTrans()

   Dim Cnt As Long
   
   Range("A1:C43").FillDown
   For Cnt = 15 To 471 Step 11
      Cells(1, Cnt).Resize(, 11).Copy Range("D" & Rows.Count).End(xlUp).Offset(1)
   Next Cnt
   Range("O:XFD").Clear
   
End Sub

The last line will clear cols O to the end, delete that line if needed

 

[JoelBrown]

Hi mate,

Thank you very much for this.

I have just tried to use this on multiple rows of data and it does not work.

I think my description above did not mention that I will be attempting to undertake this task for multiple rows of data in a SS and not just one line.

Is this a simple tweak?

Thanks again for your help.

 

[Fluff]

How about

Sub CopyTrans()

   Dim Cnt As Long
   Dim Rw As Long
   Dim r As Long
   
   For Rw = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
      r = 1
      Range("A" & Rw + 1).Resize(42).EntireRow.Insert
      Range("A" & Rw).Resize(43, 3).FillDown
      For Cnt = 15 To 471 Step 11
         Cells(Rw, Cnt).Resize(, 11).Copy Range("D" & Rw + r)
         r = r + 1
      Next Cnt
   Next Rw
   Range("O:XFD").Clear
   
End Sub

 

[JoelBrown]

That works perfectly.

Thank you very much for your time and effort. I am extremely grateful.

 

[Fluff]

Glad to help & thanks for the feedback

 

[JoelBrown]

Hi mate,

Got another question.

Is there an formula that can work for the following:

I have a sheet, lets call it Sheet A, with a column that requires information to be populated based on the answers either side of it, for example:

If in sheet 1, cell A1 had property type and cell C1 had Maisonette then I require cell B1 to have the number 4 in it based on the range below which is all in sheet 2.


Sheet 2
Column A Column B Column C

Property Type	1	House
Property Type	2	Bungalow
Property Type	3	Flat
Property Type	4	Maisonette
Property Type	5	Room
Hope this makes sense and is a simple formula. Many thanks again

<tbody>
</tbody><colgroup><col><col><col></colgroup>

 

[Fluff]

As this is a completely different question, you need to start a new thread.