# Transpose with condition

#### Pompom66

##### New Member
Good day everyone,

This code was posted some time ago, code that I have modified but, it does not work like I would it to work. Here is what I am trying to achieve.

I want to transpose infos located in Column B1 up to the last cell not empty (in this case, Cell B596), into cell D2, E2, F2, etc.. There could be up to 87 fields to fill.

In column A, I have formulas stating : If B1 = "Mise en situation", enter 1, if not enter 2. Every time 1 is entered, it is the beginning of a groupe of cells in B to be transpose in column D, E F G, etc. starting at D2.

When the next number 1 appears, It will be the beginning of a new groupe of cells to be transposed. Her is an example of what I am trying to achieve. Please note that in column B, I can have 2,000 to 3,000 cells with infos.

Ex. :
IF A1 = 1, D2 = B1
IF A2 = 2, E2 = B2
IF A3 = 2, F2 = B3
IF A4 = 1, D3 = B4
IF A5 = 2, E3 = B5
IF A6 = 2, F3 = B6
IF A7 = 2, G3 = B7
IF A8 = 1, D4 = B8
Etc.

My code :
Code:
``````Sub Transpose()
'
Dim ShAsWorksheet
Dim Rng As Range

Dim r As Long
Dim c As Integer
Dim Cell As Range
Set Sh = Worksheets("InfosWord")
Set Rng = Sh.Range("A1:A" & Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row)
r = 1
c = 2
For Each Cell In Rng
Cells(r, c).Value = Cell.Offset(2, 4).Value
With Rng
If Cell.Value <> Cell.Offset(1, 2).Value Then
Cells(r, 1).Value = Cell.Value
r = r + 1
c = 2
Else
c = c + 1

End If
End With

Next
End Sub``````

Tks for your help regarding my request,

Daniel

Windows 10, Excel 2016

### Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

#### JLGWhiz

##### Well-known Member
I am not sure I fully understand it, but you can try this and see if it gives you what you want. Requires some editing for sheet name.

Code:
``````Sub xposeB()
Dim c As Range, i As Long, j As Long, sh As Worksheet
Set sh = Sheets(1)
i = 1
With sh
For Each c In .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
If c = 1 Then
i = i + 1
j = 4
.Cells(i, j) = c.Offset(, 1).Value
j = j + 1
Else
.Cells(i, j) = c.Offset(, 1).Value
j = j + 1
End If
Next
End With
End Sub``````

Last edited:

#### Tetra201

##### MrExcel MVP
Another approach; runs faster:
Code:
``````Sub TWC()
Set LastCell = Range("A" & Rows.Count).End(xlUp)
r = 2
With Range("A1", LastCell)
Set GrpStart = .Find(1, LastCell, xlValues)
If Not GrpStart Is Nothing Then
Do
Set A = GrpStart.Offset(0, 1)
Set GrpStart = .FindNext(GrpStart)
If GrpStart.Address <> FirstGrp Then _
Set Z = GrpStart.Offset(-1, 1) Else _
Set Z = LastCell.Offset(0, 1)
Range(Cells(r, 4), Cells(r, 4 + Z.Row - A.Row)) = _
WorksheetFunction.Transpose(Range(A, Z))
r = r + 1
End If
End With
End Sub``````

#### Pompom66

##### New Member
Good day JLGWhiz,

Your code works perfectly. Can you please tell me witch forum to use for further posting?

I am french, my English writing might not be perfect. Sorry about that.

Daniel

#### JLGWhiz

##### Well-known Member
Good day JLGWhiz,

Your code works perfectly. Can you please tell me witch forum to use for further posting?

I am french, my English writing might not be perfect. Sorry about that.

Daniel
I believe your English is good enough for this forum, but there if you want to try it, there is one you can access by clicking on the quick access, then click 'Questions in Other Languages'. Like I said, your English is as good as some of us who call it our first language, but you decide.
Regards, JLG

Last edited:

Replies
1
Views
221
Replies
3
Views
457
Replies
4
Views
312
Replies
4
Views
1K
Replies
4
Views
473

1,190,782
Messages
5,982,883
Members
439,803
Latest member
sushilneupane

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back