VBA for transposing some data to a new sheet

Hi everyone, I'm a total beginner in VBA and am trying to transpose some data from one sheet to another. I have different items in column B, with corresponding quantities and sizes in column O ...

Macros and VBA

HansVogelaar

Nov 21, 2023

TeivaC

A variant:

Sub DuplicateProductsForSizes()
    Dim SourceSheet As Worksheet
    Dim TargetSheet As Worksheet
    Dim SourceRange As Range
    Dim TargetRange As Range
    Dim SourceRow As Range
    Dim ProductRange As Range
    Dim SizeColumn As Long
    Dim Size As Variant
    
    Application.ScreenUpdating = False
    Set SourceSheet = ThisWorkbook.Sheets("BL")
    On Error Resume Next
    Set TargetSheet = ThisWorkbook.Worksheets("Receiving BL")
    On Error GoTo 0
    If TargetSheet Is Nothing Then
        Set TargetSheet = ThisWorkbook.Sheets.Add
        TargetSheet.Name = "Receiving BL"
    Else
        TargetSheet.UsedRange.Clear
    End If
    Set TargetRange = TargetSheet.Range("A1")
    SourceSheet.Range("A7:F7").Copy TargetRange.Resize(1, 6)
    TargetSheet.Range("G1:H1").Value = Array("Size", "Qty")
    Set TargetRange = TargetSheet.Range("A2")
    Set SourceRange = SourceSheet.Range("A8")
    Do While SourceRange.Value <> 0
        Set ProductRange = SourceRange.Resize(1, 6)
        For SizeColumn = 15 To 21 ' O to U
            Size = SourceRange.Offset(0, SizeColumn - 1)
            If Size <> 0 Then
                ProductRange.Copy TargetRange.Resize(1, 6)
                TargetRange.Offset(0, 6).Value = SourceSheet.Cells(7, SizeColumn).Value
                TargetRange.Offset(0, 7).Value = Size
                Set TargetRange = TargetRange.Offset(1, 0)
            End If
        Next SizeColumn
        Set SourceRange = SourceRange.Offset(1, 0)
    Loop
    TargetSheet.Range(TargetSheet.Range("F1"), TargetRange.Offset(-1, 5)).Copy
    TargetSheet.Range(TargetSheet.Range("G1"), TargetRange.Offset(-1, 7)).PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Logaraj Sekar

Iron Contributor

Nov 21, 2023

Sub DuplicateProductsForSizes()
    Dim SourceSheet As Worksheet
    Dim TargetSheet As Worksheet
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim SourceRow As Range
    Dim ProductRange As Range
    Dim SizeColumn As Range
    Dim Size As Variant
    
    Set SourceSheet = ThisWorkbook.Sheets("BL")
    Set TargetSheet = ThisWorkbook.Sheets.Add
    
    TargetSheet.Name = "Receiving BL"
    
    Set sourceRange = SourceSheet.UsedRange
    Set targetRange = TargetSheet.Range("A1")
    
    SourceSheet.Range("A7:F7").Copy targetRange.Resize(1, 6)
    TargetSheet.Range("G1").Value = "Qty"
    TargetSheet.Range("H1").Value = "Size"
    
    Set targetRange = TargetSheet.Range("A2")
    For Each SourceRow In sourceRange.Rows
        Set ProductRange = SourceRow.Cells(8, 1).Resize(1, 6)
        For Each SizeColumn In SourceRow.Cells(8, 15).Resize(1, 7) ' Columns O to U
            Size = SizeColumn.Value
            If Not IsEmpty(Size) Then
                ProductRange.Copy targetRange.Resize(1, 6)
                targetRange.Cells(1, 7).Value = Size
                Set targetRange = targetRange.Offset(1, 0)
            End If
        Next SizeColumn
    Next SourceRow
    
    Sheets("BL").Range("O7:U7").Copy
    Sheets("Receiving BL").Range("H2:H211").PasteSpecial Transpose:=True
End Sub

TeivaC

TeivaC
Copper Contributor
Nov 21, 2023
Thanks a lot Logaraj, it works 🙂

Forum Discussion

VBA for transposing some data to a new sheet

Resources