Как скопировать столбцы из одного листа в другой в Excel с помощью VBA?

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

Чтобы добавить к целевому размеру вставки, если вы действительно хотите вставить весь столбец, вам нужно либо начать с начала столбца, либо выбрать весь столбец.Кроме того, я думаю, что вы хотите увеличить столбец вставки с вашим 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

Answer 2

....
'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!