如何使用VBA在excel上将列从一个工作表复制到另一个工作表？

Question

我试图将某些列从一个工作表复制到另一个工作表，但是当我应用代码时，没有错误但也没有结果。 我得到空白纸。 我在复制特定行时应用了这种方法，并将其完美地复制到了另一个工作表中。

这与成功复制行有关。 该代码可以正常工作：

Sub skdks()

Dim OSheet As Variant
Dim NSheet As Variant
Dim i As Integer
Dim LRow As Integer
Dim NSLRow As Integer

OSheet = "Tabelle3" 'Old Sheet Name
NSheet = "Tabelle5" 'New Sheet Name

LRow = Sheets(OSheet).Cells(Rows.Count, 1).End(xlUp).row 'Last Row in Old Sheet

Sheets(OSheet).Activate

For i = 2 To LRow
'Finds last row in the New Sheet
    If Sheets(NSheet).Cells(2, 1) = "" Then
        NSLRow = 1
    Else
        NSLRow = Sheets(NSheet).Cells(Rows.Count, 1).End(xlUp).row
    End If

'If cell has "certain # then..."
    If Cells(i, 1).Value = Cells(13, 2).Value Then
        Cells(i, 1).EntireRow.Copy
        Sheets(NSheet).Cells(NSLRow + 1, 1).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End If
Next i

End Sub

这小段代码是将列复制到另一个工作表的失败尝试。

Sub trial()

Dim OSheet As Variant
Dim NSheet As Variant
Dim j As Integer
Dim LColumn As Integer
Dim NSLColumn As Integer

OSheet = "Tabelle2" 'Old Sheet Name
NSheet = "Tabelle5" 'New Sheet Name

LColumn = Sheets(OSheet).Cells(1, Columns.Count).End(xlToLeft).Column  'Last Column in Old Sheet

Sheets(OSheet).Activate

For j = 2 To LColumn
'Finds last column in the New Sheet
    If Sheets(NSheet).Cells(1, 2) = "" Then
        NSLColumn = 1
    Else
        NSLColumn = Sheets(NSheet).Cells(1, Columns.Count).End(xlToLeft).Column
    End If

'If cell has "certain # then..."
    If Cells(2, j) = Cells(13, 2) Then
        Cells(2, j).EntireColumn.Copy
        Sheets(NSheet).Cells(2, 2).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End If
Next j

End Sub

Answer 1

....
'If cell has "certain # then..."
If Cells(2, j) = Cells(13, 2) Then

    debug.Print Cells(2, j).Address; " = "; Cells(13, 2).Address; " ---- COPY"
    debug.print Cells(2, j).EntireColumn.address; Cells(2, j).EntireColumn.cells.count
    debug.Print Sheets(NSheet).Cells(2, 2).Address

    Cells(2, j).EntireColumn.Copy
    Sheets(NSheet).Cells(2, 2).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End If
....

用If Cells(2, j) = Cells(13, 2) Then将第2行的不同单元格（B2，C2，D2，...）与单元格“ B13”的值进行比较。 如果值相同，则将此列复制到新工作表中。

您的数据中是否有相等的价值？ 如果是，您应该收到一条错误消息，并带有您的代码。

您尝试将整个列的值复制到以“ B2”开头的范围。 原因是没有足够的空间用于此。

=>缩小源范围或在第1行开始目标范围！

Answer 2

要增加粘贴目标的大小，如果您确实要粘贴整个列，则需要从列的开头开始或选择整个列。 另外，我想您想通过NSLColumn使粘贴列增加

If Cells(2, j) = Cells(13, 2) Then
    Cells(2, j).EntireColumn.Copy
    Sheets(NSheet).Columns(NSLColumn + 1).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End If