excel - 复制粘贴值并转置

Question

我正在尝试加快我编写的代码的速度，由于某种原因，输出与我所做的更改不同。
该代码将“<>”插入到我拥有的数字列表中，然后复制它并将转置值粘贴到另一张表中。所以在 Col A 中我有原始值，在 Col B 中我有前面带有“<>”的值。
原码

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

新代码

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

新代码间歇性地工作，并且当它工作时，它需要 B 列的值粘贴它们，然后获取 A 列的值并粘贴它们。有时代码工作正常。
我想知道我能做些什么来解决这个问题并让它快速工作？

Answer 1

复制转置值

使用Option Explicit .

限定您的对象(工作表(wb.Worksheets...)和范围(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