Question

我正在尝试将来自列B，E，I，J的过滤值粘贴到“联系人计划”表（由第I列过滤以排除空白）到单独的B，C，E，L（分别）列上工作表名为“CSVControl”。

到目前为止，我已经尝试了以下代码，但我无法将所有列粘贴到“CSVControl”中的下一个空行。目前，只有B列在第一个空行中正确粘贴，但每个后续列粘贴前一列粘贴的最后一个单元格下方约9行（每个副本包含9个条目）。

这是我的代码：

Sheets("Contact Plans").Select
Range("ContactPlansTable[#All]").Select
ActiveSheet.ListObjects("ContactPlansTable").Range.AutoFilter Field:=8, _
    Criteria1:="<>"

Sheets("Contact Plans").Select
Range(Range("B5"), Range("B5").End(xlDown)).Copy
Sheets("CSVControl").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

Sheets("Contact Plans").Select
Range(Range("E5"), Range("E5").End(xlDown)).Copy
Sheets("CSVControl").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

Sheets("Contact Plans").Select
Range("I5", Range("I" & Rows.Count).End(xlUp)).Copy
Sheets("CSVControl").Range("E" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

Sheets("Contact Plans").Select
Range("J5", Range("J" & Rows.Count).End(xlUp)).Copy
Sheets("CSVControl").Range("L" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

Answer 1

试试这段代码：

Option Explicit

Public Sub copyColumns()

    Dim wsFrom As Worksheet, wsTo As Worksheet

    With Application.ActiveWorkbook
        Set wsFrom = .Worksheets("Contact Plans")
        Set wsTo = .Worksheets("CSVControl")
    End With
    wsFrom.ListObjects("ContactPlansTable").Range.AutoFilter Field:=8, Criteria1:="<>"

    copyColumn wsFrom, wsTo, "B", "B"
    copyColumn wsFrom, wsTo, "E", "C"
    copyColumn wsFrom, wsTo, "I", "E"
    copyColumn wsFrom, wsTo, "J", "L"
    Application.CutCopyMode = False
    wsTo.Activate
    wsTo.Cells(1, 1).Activate
End Sub

Private Sub copyColumn(ws1 As Worksheet, ws2 As Worksheet, col1 As String, col2 As String)
    Dim vCells As Range
    Set vCells = ws1.Range(col1 & "5:" & col1 & ws1.Range(col1 & "5").End(xlDown).Row)
    vCells.SpecialCells(xlCellTypeVisible).Copy
    ws2.Columns(col2).End(xlDown).Offset(1).PasteSpecial xlPasteValues
End Sub

您的行偏移量无法正常工作，因为每次复制/粘贴操作后Rows.Count都会增加

如何将多个不相邻的列粘贴到另一个工作表的最后一个空行？

1 个答案: