Transposer les lignes et les colonnes d'un tableau de données

bonjour,

Ci-joint un classeur avec 2 feuilles. Je souhaiterais restructurer les données qui sont dans la feuille Compile au sein de la feuille Mapping. Cela consisterait, en gros, à transposer les lignes avec les colonnes....mais pas que.

La macro ci-dessous s'approche du résultat mais elle ne trait que le range C3:CT98 et je ne parviens pas à l'étendre aux autres lignes du tableau :

Auriez-vous une idée?

Sub CopyValuesToMapping()   

    Dim wsCompile As Worksheet
    Dim wsMapping As Worksheet
    Dim headerRow As Range
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim matchColumn As Range
    Dim searchHeader As String
    Dim matchValue As Variant
    Dim cellRow As Long
    Dim cellCol As String

    ' Référencer les feuilles de travail
    Set wsCompile = ThisWorkbook.Sheets("Compile")
    Set wsMapping = ThisWorkbook.Sheets("Mapping")
    Set headerRow = wsCompile.Rows("1")

    ' Parcourir les cellules de la ligne 3 de la feuille Mapping
    For j = 3 To 98 
        cellRow = 3
        cellCol = wsMapping.Cells(cellRow, j).Address(False, False)

        ' Obtenez le texte de la cellule A3 sur Mapping
        searchHeader = wsMapping.Range("A" & cellRow).Value

        ' Rechercher l'en-tête correspondant dans Compile
        On Error Resume Next
        Set matchColumn = headerRow.Find(What:=searchHeader, LookIn:=xlValues, LookAt:=xlWhole)
        On Error GoTo 0

        If Not matchColumn Is Nothing Then
            lastRow = wsCompile.Cells(wsCompile.Rows.Count, matchColumn.Column).End(xlUp).Row
            ' Limitez la recherche aux 901 premières lignes
            If lastRow > 901 Then lastRow = 901

            ' Parcourir les cellules pour trouver la correspondance
            For i = 1 To lastRow
                If wsCompile.Cells(i, 3).Value = wsMapping.Cells(2, j).Value Then
                    matchValue = wsCompile.Cells(i, matchColumn.Column).Value
                    Exit For
                End If
            Next i

            ' Copier la valeur correspondante
            wsMapping.Range(cellCol).Value = matchValue
        Else
            wsMapping.Range(cellCol).Value = "Aucune correspondance d'en-tête"
        End If
    Next j
End Sub
14essai.zip (662.62 Ko)

Bonjour

Sans chercher plus loin

 For j = 98 To wsMapping.Cells(k, Columns.Count).End(xlToLeft).Column ' De la colonne C à CT
wsMapping.Cells(k, Columns.Count).End(xlToLeft).Column est egale à 98....

Tu cherches ce qui est en colonne 1: "ext1",etc en ligne 1 "A1", ect....
A+ François

pour info et pour ceux qui seraient intéressés, voici un code qui fonctionne :

Sub RemplirMapping()
    Dim wsCompile As Worksheet, wsMapping As Worksheet
    Dim i As Long, j As Long
    Dim dateRow As Long, thermoCol As Long, hourRow As Long
    Dim thermoName As String, theDate As Date, theHour As String

    Set wsCompile = ThisWorkbook.Sheets("Compile")
    Set wsMapping = ThisWorkbook.Sheets("Mapping")

    For i = 3 To 901 ' Pour chaque ligne dans Mapping
        thermoName = wsMapping.Cells(i, 1).value
        theDate = wsMapping.Cells(i, 2).value

        thermoCol = 0
        dateRow = 0
        hourRow = 0

        ' Trouver la colonne du thermomètre
        For j = 4 To 34 ' à adapter selon le nombre de thermomètres
            If wsCompile.Cells(1, j).value = thermoName Then
                thermoCol = j
                Exit For
            End If
        Next j

        ' Trouver la ligne de la date
        For j = 2 To 2689 ' à adapter selon le nombre de lignes dans Compile
            If wsCompile.Cells(j, 2).value = theDate Then
                dateRow = j
                Exit For
            End If
        Next j

        ' Pour chaque heure
        For j = 3 To 98 ' à adapter selon le nombre d'heures (C2:CT2)
            theHour = wsMapping.Cells(2, j).value
            hourRow = 0

            ' Trouver la ligne de l'heure
            For k = dateRow To dateRow + 95 ' 96 repères horaires
                If wsCompile.Cells(k, 3).value = theHour Then
                    hourRow = k
                    Exit For
                End If
            Next k

            If thermoCol > 0 And hourRow > 0 Then
                wsMapping.Cells(i, j).value = wsCompile.Cells(hourRow, thermoCol).value
            End If
        Next j
    Next i
End Sub

je clôture le sujet :)

Rechercher des sujets similaires à "transposer lignes colonnes tableau donnees"