Search code examples
excelvbatranspose

VBA: Too much space left when copying rows and transposing into columns


I have written a VBA code (below) to:

  1. pick and copy rows from one sheet that meet a criterion
  2. paste those rows in a different sheet but transposed into columns e.g. copy range A1:E1 in sheet 1 and paste as A1:A5 in sheet 2, then copy A2:E2 in sheet 1 and paste as B1:B5 in sheet 2

The code (almost!) does what it's supposed to: it picks a row, copies it as a column instead BUT leaves dozens (if not more) empty columns in between each copied bit.

I tried to figure out why it is not pasting the rows as columns one after another without any spaces but I'm not really good with VBA so I'm struggling. What should I change? Any help would be much appreciated, thank you!

A = Worksheets("TO BE").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To A

    If Worksheets("TO BE").Range("D" & i).Value = "7" Then
    
    Worksheets("TO BE").Range("A" & i & ":E" & i).Copy
    
    Worksheets("GRADE 7 MATRIX").Activate
    
    b = Worksheets("GRADE 7 MATRIX").Cells(1, Columns.Count).End(xlToLeft).Column
    
    Worksheets("GRADE 7 MATRIX").Cells(1 & b + 1).Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        True, Transpose:=True
    
    End If

Next

Application.CutCopyMode = False

Solution

  • Cells(1 & b + 1) should be Cells(1, b + 1), You need to specify the Row and Column. I suppose you want pasting on the first empty column of the first row... Otherwise, your code returns on the Cell column obtained by concatenation of 1 with b + 1. If b would be 8, the column will be 18. For 20 => 120, and so on. It only happens that it pastes on the first row, not 'telling' that by your code... It would reach the second row only after 16384 (the total number of columns).

    Then, you must not select/activate anything. Your code (working faster and more stable), when condition is True, should be:

    Worksheets("TO BE").Range("A" & i & ":E" & i).Copy
        b = Worksheets("GRADE 7 MATRIX").Cells(1, Columns.Count).End(xlToLeft).Column   
        Worksheets("GRADE 7 MATRIX").Cells(1, b + 1).PasteSpecial _
               Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
                                                True, Transpose:=True