CODEWITHSUNDEEP
excelvbacopytranspose
Bikat Uprety
Bikat Uprety

Reputation: 139

Copy paste values and transpose

I'm trying to speed up a code that I've written and for some reason the output is not the same with the changes I made.

The code inserts "<>" into a list of numbers that I have and then it copies it and paste transposes values into another sheet. So in Col A I have the original values and in Col B I have values with "<>" infront of them.

Original code

Set ws = ActiveSheet

With ws.Range("A3:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    .EntireRow.Columns("B").Formula = "=""<>""&" & .Cells(1).Address(0, 0)
End With

Range("B4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sheet 2").Select
Range("I2").Select

On Error Resume Next
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
On Error GoTo 0

New Code

Set ws = Sheets("Sheet 1")

With ws.Range("A3:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    .EntireRow.Columns("B").Formula = "=""<>""&" & .Cells(1).Address(0, 0)
End With

Range("B4").Select
Range(Selection, Selection.End(xlDown)).Copy
Sheets("Sheet 2").Select
Range("I2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True

The new code works intermittently and also when it does work it takes values of column B pastes them and then takes the values of column A and pastes them too. Sometimes the code works fine.

I was wondering what I could do to resolve this issue and for it to work quickly?

Upvotes: 2

Views: 781

Answers (1)

VBasic2008
VBasic2008

Reputation: 54807

Copy Transposed Values

  • Use Option Explicit.
  • Qualify your objects (worksheets (wb.Worksheets...) and ranges (sws.Range..., sws.Cells..., sws.Rows...)).
Option Explicit

Sub CopyColumn()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
    
    With sws.Range("A3", sws.Cells(sws.Rows.Count, "A").End(xlUp))
        .EntireRow.Columns("B").Formula = "=""<>""&" & .Cells(1).Address(0, 0)
        With .Resize(.Rows.Count - 1).Offset(1, 1)
            dws.Range("I2").Resize(, .Rows.Count).Value _
                = Application.Transpose(.Value)
        End With
    End With

End Sub

Upvotes: 1

Related Questions