Note: The other languages of the website are Google-translated. Back to English
Se connecter  \/ 
x
or
x
INSCRIPTION  \/ 
x

or

 Comment transposer des cellules dans une colonne en fonction de valeurs uniques dans une autre colonne?

En supposant que vous ayez une plage de données contenant deux colonnes, vous souhaitez maintenant transposer les cellules d'une colonne en lignes horizontales en fonction de valeurs uniques dans une autre colonne pour obtenir le résultat suivant. Avez-vous de bonnes idées pour résoudre ce problème dans Excel?

doc transposer les valeurs uniques 1

Transposer les cellules dans une colonne en fonction de valeurs uniques avec des formules

Transposer les cellules dans une colonne en fonction de valeurs uniques avec le code VBA

Transposer les cellules dans une colonne en fonction de valeurs uniques avec Kutools for Excel


Avec les formules matricielles suivantes, vous pouvez extraire les valeurs uniques et transposer leurs données correspondantes en lignes horizontales, procédez comme suit:

1. Entrez cette formule matricielle: = INDEX ($ A $ 2: $ A $ 16, MATCH (0, COUNTIF ($ D $ 1: $ D1, $ A $ 2: $ A $ 16), 0)) dans une cellule vide, D2, par exemple, et appuyez sur Maj + Ctrl + Entrée clés ensemble pour obtenir le résultat correct, voir capture d'écran:

doc transposer les valeurs uniques 2

Notes: Dans la formule ci-dessus, A2: A16 est la colonne dont vous souhaitez répertorier les valeurs uniques, et D1 est la cellule au-dessus de cette cellule de formule.

2. Faites ensuite glisser la poignée de remplissage vers les cellules pour extraire toutes les valeurs uniques, voir capture d'écran:

doc transposer les valeurs uniques 3

3. Et puis continuez à entrer cette formule dans la cellule E2: =IFERROR(INDEX($B$2:$B$16, MATCH(0, COUNTIF($D2:D2,$B$2:$B$16)+IF($A$2:$A$16<>$D2, 1, 0), 0)), 0), et n'oubliez pas d'appuyer sur Maj + Ctrl + Entrée clés pour obtenir le résultat, voir capture d'écran:

doc transposer les valeurs uniques 4

Notes: Dans la formule ci-dessus: B2: B16 correspond aux données de la colonne que vous souhaitez transposer, A2: A16 est la colonne sur laquelle vous souhaitez transposer les valeurs en fonction, et D2 contient la valeur unique que vous avez extraite à l'étape 1.

4. Faites ensuite glisser la poignée de remplissage à droite des cellules dans lesquelles vous souhaitez lister les données transposées jusqu'à ce que affiche 0, voir capture d'écran:

doc transposer les valeurs uniques 5

5. Et puis continuez à faire glisser la poignée de remplissage vers la plage de cellules pour obtenir les données transposées comme illustré ci-dessous:

doc transposer les valeurs uniques 6


Peut-être que les formules sont complexes à comprendre, ici, vous pouvez exécuter le code VBA suivant pour obtenir le résultat souhaité dont vous avez besoin.

1. Maintenez le ALT + F11 clés pour ouvrir le Microsoft Visual Basic pour applications fenêtre.

2. Cliquez insérer > Moduleet collez le code suivant dans le Module Fenêtre.

Code VBA: transposez les cellules dans une colonne en fonction de valeurs uniques dans une autre colonne:

Sub transposeunique()
'updateby Extendoffice
    Dim xLRow As Long
    Dim i As Long
    Dim xCrit As String
    Dim xCol  As New Collection
    Dim xRg As Range
    Dim xOutRg As Range
    Dim xTxt As String
    Dim xCount As Long
    Dim xVRg As Range
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("please select data range(only two columns):", "Kutools for Excel", xTxt, , , , , 8)
    Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
    If xRg Is Nothing Then Exit Sub
    If (xRg.Columns.Count <> 2) Or _
       (xRg.Areas.Count > 1) Then
        MsgBox "the used range is only one area with two columns ", , "Kutools for Excel"
        Exit Sub
    End If
    Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
    If xOutRg Is Nothing Then Exit Sub
    Set xOutRg = xOutRg.Range(1)
    xLRow = xRg.Rows.Count
    For i = 2 To xLRow
        xCol.Add xRg.Cells(i, 1).Value, xRg.Cells(i, 1).Value
    Next
    Application.ScreenUpdating = False
    For i = 1 To xCol.Count
        xCrit = xCol.Item(i)
        xOutRg.Offset(i, 0) = xCrit
        xRg.AutoFilter Field:=1, Criteria1:=xCrit
        Set xVRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)
        If xVRg.Count > xCount Then xCount = xVRg.Count
        xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible).Copy
        xOutRg.Offset(i, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
    Next
    xOutRg = xRg.Cells(1, 1)
    xOutRg.Offset(0, 1).Resize(1, xCount) = xRg.Cells(1, 2)
    xRg.Rows(1).Copy
    xOutRg.Resize(1, xCount + 1).PasteSpecial Paste:=xlPasteFormats
    xRg.AutoFilter
    Application.ScreenUpdating = True
End Sub

3. Puis appuyez F5 clé pour exécuter ce code, et une boîte de dialogue apparaîtra pour vous rappeler de sélectionner la plage de données que vous souhaitez utiliser, voir capture d'écran:

doc transposer les valeurs uniques 7

4. Et puis cliquez OK bouton, une autre boîte de dialogue apparaîtra pour vous rappeler de sélectionner une cellule pour mettre le résultat, voir capture d'écran:

doc transposer les valeurs uniques 8

6. Cliquez OK bouton, et les données de la colonne B ont été transposées en fonction des valeurs uniques de la colonne A, voir capture d'écran:

doc transposer les valeurs uniques 9


Si vous avez Kutools pour Excel, combinant le Lignes de combinaison avancées et Cellules divisés utilitaires, vous pouvez terminer rapidement cette tâche sans aucune formule ni code.

Kutools pour Excel : avec plus de 300 compléments Excel pratiques, essai gratuit sans limitation en 30 jours.

Après l'installation de Kutools pour Excel, procédez comme suit:

1. Sélectionnez la plage de données que vous souhaitez utiliser. (Si vous souhaitez conserver les données d'origine, veuillez d'abord copier et coller les données dans un autre emplacement.)

2. Puis clique Kutools > Fusionner et fractionner > Lignes de combinaison avancées, voir capture d'écran:

3. Dans le Combiner des lignes en fonction de la colonne boîte de dialogue, veuillez effectuer les opérations suivantes:

(1.) Cliquez sur le nom de la colonne sur laquelle vous souhaitez transposer les données, puis sélectionnez Clé primaire;

(2.) Cliquez sur une autre colonne que vous souhaitez transposer, puis cliquez sur Combiner puis choisissez un séparateur pour séparer les données combinées, telles que l'espace, la virgule, le point-virgule.

doc transposer les valeurs uniques 11

4. Puis clique Ok bouton, les données de la colonne B ont été combinées dans une cellule basée sur la colonne A, voir capture d'écran:

doc transposer les valeurs uniques 12

5. Et puis sélectionnez les cellules combinées et cliquez sur Kutools > Fusionner et fractionner > Cellules divisés, voir capture d'écran:

6. Dans le Cellules divisés boîte de dialogue, sélectionnez Fractionner en colonnes sous le Type option, puis choisissez le séparateur qui sépare vos données combinées, voir capture d'écran:

doc transposer des valeurs uniques 14 14

7. Puis clique Ok et sélectionnez une cellule pour mettre le résultat de la division dans la boîte de dialogue qui apparaît, voir capture d'écran:

doc transposer les valeurs uniques 15

8. Cliquez OK, et vous obtiendrez le résultat dont vous avez besoin. Voir la capture d'écran:

doc transposer les valeurs uniques 16

Téléchargez et essayez gratuitement Kutools for Excel Now!


Kutools pour Excel: avec plus de 300 compléments Excel pratiques, essai gratuit sans limitation dans 30 jours. Téléchargez et essayez gratuitement maintenant!

Les meilleurs outils de productivité de bureau

Kutools for Excel résout la plupart de vos problèmes et augmente votre productivité de 80%

  • Réutilisation: Insérer rapidement formules complexes, graphiques et tout ce que vous avez utilisé auparavant; Crypter les cellules avec mot de passe; Créer une liste de diffusion et envoyer des e-mails ...
  • Barre Super Formula (modifiez facilement plusieurs lignes de texte et de formule); Disposition de lecture (lire et modifier facilement un grand nombre de cellules); Coller dans la plage filtrée...
  • Fusionner les cellules / lignes / colonnes sans perdre de données; Contenu des cellules divisées; Combiner des lignes / colonnes en double... Empêcher les cellules en double; Comparer les gammes...
  • Sélectionnez Dupliquer ou Unique Lignes; Sélectionnez les lignes vides (toutes les cellules sont vides); Super Find et Fuzzy Find dans de nombreux classeurs; Sélection aléatoire ...
  • Copie exacte Plusieurs cellules sans changer la référence de formule; Créer automatiquement des références à plusieurs feuilles; Insérer des puces, Cases à cocher et plus encore ...
  • Extrait du texte, Ajouter du texte, Supprimer par position, Supprimer l'espace; Créer et imprimer des sous-totaux de pagination; Conversion entre le contenu et les commentaires des cellules...
  • Super filtre (enregistrer et appliquer des schémas de filtrage à d'autres feuilles); Tri avancé par mois / semaine / jour, fréquence et plus; Filtre spécial par gras, italique ...
  • Combiner des classeurs et des feuilles de travail; Fusionner les tableaux en fonction des colonnes clés; Diviser les données en plusieurs feuilles; Conversion par lots xls, xlsx et PDF...
  • Plus de 300 fonctionnalités puissantes. Prend en charge Office / Excel 2007-2019 et 365. Prend en charge toutes les langues. Déploiement facile dans votre entreprise ou organisation. Essai gratuit de 30 jours. Garantie de remboursement de 60 jours.
onglet kte 201905

Office Tab apporte une interface à onglets à Office et simplifie considérablement votre travail

  • Activer l'édition et la lecture par onglets dans Word, Excel, PowerPoint, Publisher, Access, Visio et Project.
  • Ouvrez et créez plusieurs documents dans de nouveaux onglets de la même fenêtre, plutôt que dans de nouvelles fenêtres.
  • Augmente votre productivité de 50% et réduit des centaines de clics de souris chaque jour!
bas de cabine
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Alicia · 20 days ago
    Like many people in the below my column "b" has duplicates I still want to appear in a column, I.e. 

    How to do the transpose if B column doesn't have unique values but still need those values
    KTE 100
    KTE 100

    Can you shared a modified equation that works in that scenario? I appears lots of people have this question below without an answer.

    Thank you, 
    • To post as a guest, your comment is unpublished.
      skyyang · 19 days ago
      Hello, Alicia,
      If there are duplicate values in the second column, you should apply the below array formula:
      =IFERROR(INDEX($B$2:$B$16,SMALL(IF($D2=$A$2:$A$16,ROW($A$2:$A$16)-ROW($A$2)+1),COLUMN(A1))),"")
      After inserting the formula, please remember to press Shift + Ctrl + Enter keys.

      Please try, hope it can help you!

  • To post as a guest, your comment is unpublished.
    Alex · 1 months ago
    how would you do the first order but with multiple columns of data for each product? Like if KTO and KTE had multiple pieces of data in columns C, D, E,...

    This was the formula used:

    =IFERROR(INDEX($B$2:$B$16, MATCH(0, COUNTIF($D2:D2,$B$2:$B$16)+IF($A$2:$A$16<>$D2, 1, 0), 0)), 0)
  • To post as a guest, your comment is unpublished.
    Harish · 2 months ago
    thanks !! just what i was looking for !! works as intended !!
  • To post as a guest, your comment is unpublished.
    Gregg · 1 years ago
    this was a very, very helpful post - thank you!
    I found the VBA version did not yield the expected results at least when running in VBA 7.1 (Excel for Office 365 - 16.0.x - 64-bit). I tweaked it a bit to get the results I wanted:


    Sub transposeunique()
    'updateby Extendoffice
    'updateby skipow June 2020
    Dim xLRow As Long
    Dim i As Long
    Dim xCrit As String
    Dim xCritLast As String
    Dim xCol As New Collection
    Dim xRg As Range
    Dim xOutRg As Range
    Dim xTxt As String
    Dim xCount As Long
    Dim xVRg As Range
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("please select data range(only two columns):", "Kutools for Excel", xTxt, , , , , 8)
    Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
    If xRg Is Nothing Then Exit Sub
    If (xRg.Columns.Count <> 2) Or _
    (xRg.Areas.Count > 1) Then
    MsgBox "the used range is only one area with two columns ", , "Kutools for Excel"
    Exit Sub
    End If
    Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
    If xOutRg Is Nothing Then Exit Sub
    Set xOutRg = xOutRg.Range(1)
    xLRow = xRg.Rows.Count
    For i = 2 To xLRow
    'xCol.Add xRg.Cells(i, 1).Value, xRg.Cells(i, 1).Value
    'the above line commented out - the Add function to the Collection (at least in VBA 7.1) doesn't accept this format
    xCol.Add Item:=xRg.Cells(i, 1).Value
    'you only need the first column put into the Collection

    Next
    Application.ScreenUpdating = False
    For i = 1 To xCol.Count
    xCrit = xCol.Item(i)
    'if you don't keep track of the last entry and compare to the next entry you'll get duplicate lines
    If xCrit = xCritLast Then
    xRg.AutoFilter
    Else
    xOutRg.Offset(i, 0) = xCrit
    xRg.AutoFilter Field:=1, Criteria1:=xCrit
    Set xVRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)
    If xVRg.Count > xCount Then xCount = xVRg.Count
    xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible).Copy
    xOutRg.Offset(i, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False
    'save the last entry and compare above to the next one to avoid duplicates
    xCritLast = xCrit
    End If
    Next
    xOutRg = xRg.Cells(1, 1)
    xOutRg.Offset(0, 1).Resize(1, xCount) = xRg.Cells(1, 2)
    xRg.Rows(1).Copy
    xOutRg.Resize(1, xCount + 1).PasteSpecial Paste:=xlPasteFormats
    xRg.AutoFilter
    Application.ScreenUpdating = True
    End Sub

    • To post as a guest, your comment is unpublished.
      Zoe · 2 months ago
      This works, but it gives me duplicates. Is there a way to make it not?
      • To post as a guest, your comment is unpublished.
        Harish · 2 months ago
        it worked for me, i had to sort the first column though
  • To post as a guest, your comment is unpublished.
    ygoyal578@gmail.com · 1 years ago
    can you please share the code if there are 2 columns to be copied instead of 1. below is the example.
  • To post as a guest, your comment is unpublished.
    gabimargareta204@gmail.com · 1 years ago
    I have a data set which has 3 columns presented below:

    Column A Column B Column C

    Country1 Year1 Value1
    Country1 Year2 Value2
    Country1 Year3 Value3,

    Country2 Year1 Value1
    Country2 Year3 Value3,
    ...........

    I need to combine these 3 columns in a table like this:

    Year1 Year2 Year3 ................................. YearX


    Country1 Value1 Value2 Value3
    Country2 Value1 #Missing Value3
    .....
    .....
    .....
    CountryX Valuex ..................



    The problem i am facing is that for some data in column A i don't have values for each year only for some.(For example country 2 has missing values for Year 2)


    Is there a way to work around this issue and resolve it?

    Thank you in advance!
  • To post as a guest, your comment is unpublished.
    emsequeira · 2 years ago
    I have a data set which has multiple IDs in column A, and has connected data in column B. I used the above formula and altered it a bit so that I am transposing the cells in the column B into a row based on the unique ID tied to it in column A. The formula used to identify the unique IDs is: =INDEX($A$2:$A$13409, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$13409), 0)). The formula used to do the transposing is: =IFERROR(INDEX($B$2:$B$13409, MATCH(0, IF($A$2:$A$13409<>$D2, 1, 0)+COUNTIF($D2:D2,$B$2:$B$13409), 0)), "N/A"). Both given in the article, only slightly altered.

    The issue is my data set in column B has duplicates, sometimes appearing one after another, and I need all of the values in the column to be presented in the rows.

    The image attached is what I would like the table to show (this is a small sample size, the true dataset has over 13,000 entries). What is happening now is when a repeat value is encountered, it will not count it.
    i.e. Row 9 for ID 11980 now only shows 0 -31.79 -0.19 -0.74 N/A N/A .... when what I need it to show instead is 0 0 -31.79 -0.19 -0.74 0 0 N/A N/A ....

    Is there a way to work around this issue and resolve it?

    Thank you in advance!
    • To post as a guest, your comment is unpublished.
      Alicia · 20 days ago
      Did you ever get a response/resolution to this challenge? I have the same one.

  • To post as a guest, your comment is unpublished.
    ariellerazzy · 2 years ago
    I have a data set in Columns A (Unique ID) - E. Each row has data based on the ID#, there are multiple rows for each ID# but I want one row per ID# with all of the other data in columns (it would be 5 columns long minimum and 25 maximum depending on how many each unique ID has). I found a code but it only works for two columns. I had to concatenate the four columns (not including ID) then delimit after running the macro (lot of work). For 15,000 rows of data this is extra time consuming. Is there an endless column macro that would work? Thanks in advance everyone for your help!
    ID CODE ST CODE# DATE
  • To post as a guest, your comment is unpublished.
    martha Bright · 2 years ago
    The macro did not work. It just copied the contents in cell A1.
  • To post as a guest, your comment is unpublished.
    Vinod · 2 years ago
    =INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0)) worked for me to transpose the unique values of A column into a new column BUT...is there a way to get the all the values in B column to be transposed as given below:

    Product Order Date Product Order Order Order Order Order Order Order
    KTE 100 3/3/2019 KTE 100 100 100 200 100 150 100
    KTO 150 3/3/2019 KTO 150 100 200 100 150 200
    KTE 100 3/4/2019 BOT 150 100 200 150 100 200
    KTO 100 3/4/2019 COD 200 150 100 150
    KTO 200 3/5/2019
    KTE 100 3/5/2019
    BOT 150 3/5/2019
    BOT 100 3/6/2019
    KTO 100 3/6/2019
    KTE 200 3/6/2019
    BOT 200 3/7/2019
    COD 200 3/7/2019
    KTE 100 3/7/2019
    KTO 150 3/7/2019
    BOT 150 3/8/2019
    KTE 150 3/8/2019
    COD 150 3/8/2019
    BOT 100 3/9/2019
    BOT 200 3/10/2019
    COD 100 3/10/2019
    KTO 200 3/10/2019
    COD 150 3/11/2019
    KTE 100 3/11/2019
  • To post as a guest, your comment is unpublished.
    seanviz18@gmail.com · 2 years ago
    So I am working for a company. We have columns for info such as Last name, first name, rank, section, phone number, address. Is there a way I can use a similar formula to transpose the entire row of info to a column by names?
  • To post as a guest, your comment is unpublished.
    kumar · 2 years ago
    Hi can we add each row and give the output in one column, with the above functionality.
  • To post as a guest, your comment is unpublished.
    raj · 2 years ago
    Need to get the same out put but for predefined columns to be selected would be ($A,$B) and need the output column Position on $D$1.
    If any one have idea's that would be a great help!!!!
  • To post as a guest, your comment is unpublished.
    Kate · 3 years ago
    =INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0)) worked for me to transpose the unique values of a column into a new column BUT...is there a way to ad in a sort function so that the new column created is transposed in ascending order?


    Thanks!
  • To post as a guest, your comment is unpublished.
    Prial · 3 years ago
    Same as Dave, I need to do the exactly opposite of this. Table 2 to transpose to Table 1. Input Table 2, Output Table 1.
  • To post as a guest, your comment is unpublished.
    dababler@gmail.com · 3 years ago
    I need to do exactly the opposite of this. I have many many columns associated with a row id and I want to paste them into two columns
    for example I have
    rowid, value, value1, value2, value3, value4, value..225
    100, Dolphin, 255, 9--, sarah, jameson, ....
    179, Router, flood, jason, 89, nose



    I want it to look like this
    100, Dolphin
    100, 255
    100, 9--
    100, sarah
    100, jaemeson
    179, Router
    179, flood
    179, jason
    179, 89
    179, nose
    • To post as a guest, your comment is unpublished.
      skyyang · 3 years ago
      Hello, Dave,
      To solve your problem, please use the below VBA code: (Note: When you select the data range that you want to transpose, please exclude the header row.)

      Sub TransposeUnique_2()
      Dim xLRow, xLCount As Long
      Dim xRg As Range
      Dim xOutRg As Range
      Dim xObjRRg As Range
      Dim xTxt As String
      Dim xCount As Long
      Dim xVRg As Range
      On Error Resume Next
      xTxt = ActiveWindow.RangeSelection.Address
      Set xRg = Application.InputBox("please select data range:", "Kutools for Excel", xTxt, , , , , 8)
      Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
      If xRg Is Nothing Then Exit Sub
      If (xRg.Rows.count < 2) Or _
      (xRg.Areas.count > 1) Then
      MsgBox "Invalid selection", , "Kutools for Excel"
      Exit Sub
      End If
      Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
      If xOutRg Is Nothing Then Exit Sub
      Application.ScreenUpdating = False
      xLCount = xRg.Columns.count
      For xLRow = 1 To xRg.Rows.count
      Set xObjRRg = Range(xRg.Cells(xLRow, 2), xRg.Cells(xLRow, xLCount)).SpecialCells(xlCellTypeConstants)
      xObjRRg.Copy
      xOutRg.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
      Application.CutCopyMode = False
      Range(Cells(xOutRg.Row, xOutRg.Column), Cells(xOutRg.Row + xObjRRg.count - 1, xOutRg.Column)).Value = xRg.Cells(xLRow, 1).Value
      Set xOutRg = xOutRg.Offset(RowOffset:=xObjRRg.count)
      Next
      Application.ScreenUpdating = True
      End Sub
      • To post as a guest, your comment is unpublished.
        ygoyal578@gmail.com · 1 years ago
        Hello Skyyang,
        please share the code for 3 columns. Below is the example:

        I want the data like: yogesh@gmail.com community 1 view only community 2 view only ......
        goyal@gmail.com community 1 view only community 2 view only........

        • To post as a guest, your comment is unpublished.
          skyyang · 1 years ago
          Hello, ygoyal,
          To solve your problem, please apply the below code:
          Sub TransposeUnique_2()
          Dim xLRow, xLCount As Long
          Dim xRg As Range
          Dim xOutRg As Range
          Dim xObjRRg As Range
          Dim xTxt As String
          Dim xCount As Long
          Dim xVRg As Range
          Dim xC, xI, xI1, xI2 As Integer
          On Error Resume Next
          xTxt = ActiveWindow.RangeSelection.Address
          Set xRg = Application.InputBox("please select data range:", "Kutools for Excel", xTxt, , , , , 8)
          Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
          If xRg Is Nothing Then Exit Sub
          If (xRg.Rows.Count < 2) Or _
          (xRg.Areas.Count > 1) Then
          MsgBox "Invalid selection", , "Kutools for Excel"
          Exit Sub
          End If
          Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
          If xOutRg Is Nothing Then Exit Sub
          Application.ScreenUpdating = False
          xLCount = xRg.Columns.Count
          For xLRow = 1 To xRg.Rows.Count
          Set xObjRRg = Range(xRg.Cells(xLRow, 2), xRg.Cells(xLRow, xLCount)).SpecialCells(xlCellTypeConstants)
          On Error Resume Next
          xC = (xObjRRg.Count Mod 2)
          If xC <> 0 Then
          xC = Int(xObjRRg.Count / 2) + 1
          Else
          xC = Int(xObjRRg.Count / 2)
          End If
          xI1 = 1
          xI2 = 2
          For xI = 1 To xC
          Range(xObjRRg.Item(xI1), xObjRRg.Item(xI2)).Copy
          xOutRg.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
          Application.CutCopyMode = False
          xOutRg.Value = xRg.Cells(xLRow, 1).Value
          Set xOutRg = xOutRg.Offset(RowOffset:=1)
          xI1 = xI1 + (2)
          xI2 = xI2 + (2)
          Next
          Next
          Application.ScreenUpdating = True
          End Sub

          Please try, hope it can help you!
          • To post as a guest, your comment is unpublished.
            ygoyal578@gmail.com · 1 years ago
            Hello
          • To post as a guest, your comment is unpublished.
            ygoyal578@gmail.com · 1 years ago
            Hello Bro, still waiting for your help
          • To post as a guest, your comment is unpublished.
            Yogesh · 1 years ago
            Bro, pls help in this.
          • To post as a guest, your comment is unpublished.
            ygoyal578@gmail.com · 1 years ago
            Hello Bro, The code is working opposite. Please refer the attached screen shot of requirement.
            The data available is row-wise and want to transpose the data in columns .
            • To post as a guest, your comment is unpublished.
              skyyang · 1 years ago
              Hi, ygoyal,
              Sorry for replying late, please apply the following code, please try it!

              Sub transposeunique()
              'updateby Extendoffice
              Dim xLRow As Long
              Dim i As Long
              Dim xCrit As String
              Dim xCol As New Collection
              Dim xRg As Range
              Dim xOutRg As Range
              Dim xTxt As String
              Dim xCount As Long
              Dim xVRg As Range
              Dim xFRg, xSRg, xCRg As Range
              On Error Resume Next
              xTxt = ActiveWindow.RangeSelection.Address
              Set xRg = Application.InputBox("please select data range(only 3 columns):", "Kutools for Excel", xTxt, , , , , 8)
              Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
              If xRg Is Nothing Then Exit Sub
              If (xRg.Columns.Count <> 3) Or _
              (xRg.Areas.Count > 1) Then
              MsgBox "the used range is only one area with two columns ", , "Kutools for Excel"
              Exit Sub
              End If
              Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
              If xOutRg Is Nothing Then Exit Sub
              Set xOutRg = xOutRg.Range(1)
              xLRow = xRg.Rows.Count
              For i = 2 To xLRow
              xCol.Add xRg.Cells(i, 1).Value, xRg.Cells(i, 1).Value
              Next
              Application.ScreenUpdating = False
              Application.ScreenUpdating = False
              For i = 1 To xCol.Count
              xCrit = xCol.Item(i)
              xOutRg.Offset(i, 0) = xCrit
              xRg.AutoFilter Field:=1, Criteria1:=xCrit
              Set xVRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)
              If xVRg.Count > xCount Then xCount = xVRg.Count
              Set xSRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)
              Set xCRg = xOutRg.Offset(i, 1)
              For Each xFRg In xSRg
              xFRg.Copy
              xCRg.PasteSpecial
              xRg.Range("B1").Copy
              xCRg.Offset(-(i), 0).PasteSpecial
              xFRg.Offset(0, 1).Copy
              Set xCRg = xCRg.Offset(0, 1)
              xCRg.PasteSpecial
              xRg.Range("c1").Copy
              xCRg.Offset(-(i), 0).PasteSpecial
              Set xCRg = xCRg.Offset(0, 1)
              Next
              Application.CutCopyMode = False
              Next
              xRg.Item(1).Copy
              xOutRg.PasteSpecial
              xRg.AutoFilter
              Application.ScreenUpdating = True
              End Sub
              • To post as a guest, your comment is unpublished.
                carlos7z · 7 months ago
                Hi Skyyang, Love this, any chance you could get it to work for four columns? again just using the first two as a comparator, or better still the ability to choose the number of columns before selecting them? I took a look at your script, wouldn't have a clue on how to achieve this...
              • To post as a guest, your comment is unpublished.
                carlos7z · 7 months ago
                Hi Skyyang, Love this, any chance you could get it to work for four columns? again just using the first two as a comparator, or better still the ability to choose the number of columns before selecting them? I took a look at your script, wouldn't have a clue on how to achieve this...
              • To post as a guest, your comment is unpublished.
                ygoyal578@gmail.com · 1 years ago
                Hey Bro I tried using this code but the excel goes hang when I run this code and could not see the output from the above code. please suggest what to do in this case.
                • To post as a guest, your comment is unpublished.
                  skyyang · 1 years ago
                  Hi,
                  The code works well in my workbook, which Excel version do you use?
                  • To post as a guest, your comment is unpublished.
                    ygoyal578@gmail.com · 1 years ago
                    MS Excel 2016
                    • To post as a guest, your comment is unpublished.
                      skyyang · 1 years ago
                      The code works fine in my Excel 2016 as well, please try it with some smalll range data first.
                      • To post as a guest, your comment is unpublished.
                        ygoyal578@gmail.com · 1 years ago
                        Have tested on 160 records but in that still duplicate was there.
      • To post as a guest, your comment is unpublished.
        Anna · 3 years ago
        Thank you, it works perfectly, you saved me 2 days! :)
  • To post as a guest, your comment is unpublished.
    GDamasco85 · 3 years ago
    With the formula below:

    =IFERROR(INDEX($B$2:$B$45, MATCH(0, COUNTIF($D2:D2,$B$2:$B$45)+IF($A$2:$A$10<>$D2, 1, 0), 0)), 0)

    How can I transpose the data using approximate matches? Say, I want to extract all the values from Column B that match the first 9 characters / digits from Column A? Column B has 11 characters while A only 9. thank you!
  • To post as a guest, your comment is unpublished.
    Guest · 3 years ago
    i want to transpose duplicate values too (all values - unique + duplicate) and not just unique values. Can you give the formula for that too.
    • To post as a guest, your comment is unpublished.
      joyalisac25 · 7 months ago
      I need the same
      • To post as a guest, your comment is unpublished.
        Alicia · 20 days ago
        Did you ever get a response/resolution to this challenge? I have the same one.
  • To post as a guest, your comment is unpublished.
    aidan5800 · 3 years ago
    Is there a way of doing this in reverse? I.e. data in rows of varying length and so sorting it into two columns? See attached.
  • To post as a guest, your comment is unpublished.
    mathewdidin@gmail.com · 3 years ago
    How to do the transpose if B column doesn't have unique values but still need those values
    KTE 100
    KTE 100
    Assuming that they are two different transaction
    • To post as a guest, your comment is unpublished.
      joyalisac25 · 7 months ago
      I too need the same. I want to display 100 twice is if there in the data

      • To post as a guest, your comment is unpublished.
        joyalisac25 · 7 months ago
        Can you suggest a formula for that

        • To post as a guest, your comment is unpublished.
          Alicia · 20 days ago
          Did you ever get a response/resolution to this challenge? I have the same one.
    • To post as a guest, your comment is unpublished.
      skyyang · 3 years ago
      Hi,Didin,

      Can you give your problem more clearly or detailed?
      You can insert an example screenshot for your problem.
      Thank you!
      • To post as a guest, your comment is unpublished.
        Bharath · 3 months ago
        Hi there,

        Could you please help me with below requirement.

        Product ----- order
        KTE           ------ 100
        KTE           ------ 200
        KTO           ------ 300
        KTO          ------   300

        expected output

        Product ----- order ----- order ------ order
        KTE      ------ 100  ------ 200
        KTO     ------ 300   ------ 300







  • To post as a guest, your comment is unpublished.
    Sanjeev Chidambaram · 4 years ago
    I just want to do the opposite. Like i have the end result already, and i want to achieve the first step.
    • To post as a guest, your comment is unpublished.
      Chris · 4 years ago
      I am looking for the same thing
      • To post as a guest, your comment is unpublished.
        Juan Carlos · 3 years ago
        Did you find any solution for the opposite scenario? Thanks!
        • To post as a guest, your comment is unpublished.
          Prial · 3 years ago
          I want to do the opposite as well. Any solution you got gents?
          • To post as a guest, your comment is unpublished.
            skyyang · 3 years ago
            Hello, guys,
            To get the opposite result based on the example of this article, you can apply the following VBA code: (Note:When selecting the data range that you want to transpose, please exclude the header row)

            Sub TransposeUnique_2()
            Dim xLRow, xLCount As Long
            Dim xRg As Range
            Dim xOutRg As Range
            Dim xObjRRg As Range
            Dim xTxt As String
            Dim xCount As Long
            Dim xVRg As Range
            On Error Resume Next
            xTxt = ActiveWindow.RangeSelection.Address
            Set xRg = Application.InputBox("please select data range:", "Kutools for Excel", xTxt, , , , , 8)
            Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
            If xRg Is Nothing Then Exit Sub
            If (xRg.Rows.count < 2) Or _
            (xRg.Areas.count > 1) Then
            MsgBox "Invalid selection", , "Kutools for Excel"
            Exit Sub
            End If
            Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
            If xOutRg Is Nothing Then Exit Sub
            Application.ScreenUpdating = False
            xLCount = xRg.Columns.count
            For xLRow = 1 To xRg.Rows.count
            Set xObjRRg = Range(xRg.Cells(xLRow, 2), xRg.Cells(xLRow, xLCount)).SpecialCells(xlCellTypeConstants)
            xObjRRg.Copy
            xOutRg.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
            Range(Cells(xOutRg.Row, xOutRg.Column), Cells(xOutRg.Row + xObjRRg.count - 1, xOutRg.Column)).Value = xRg.Cells(xLRow, 1).Value
            Set xOutRg = xOutRg.Offset(RowOffset:=xObjRRg.count)
            Next
            Application.ScreenUpdating = True
            End Sub
  • To post as a guest, your comment is unpublished.
    Pradeep · 4 years ago
    First step itself fails
    =INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0)) gives Value Not Available error
  • To post as a guest, your comment is unpublished.
    Piyush · 4 years ago
    This was fantastic.
    I had an excel with around 2000 unique values in row A and couldn't have managed this exercise without your help.

    Many many thanks.
  • To post as a guest, your comment is unpublished.
    Tim · 4 years ago
    How would I go in the opposite direction? From multiple columns into a single column? Thanks in advance!

    Tim