时间戳

首页 > 解决方案 > 使用 VBA 将所选列复制并粘贴到 Excel 中的表末尾

excel - 使用 VBA 将所选列复制并粘贴到 Excel 中的表末尾

问题描述

在同一个工作表中，我有一个表，每次添加新数据时，我都需要将此表的最后 4 列复制到同一个表的右端，以便添加新数据。主要原因是我总是想保持相同的格式，有些列有下拉列表和公式。

我在下面的网站中找到了下一个代码。它对于复制/粘贴行非常有效，因此我尝试修改代码以针对列执行此操作，但我无法管理。

我是 VBA 的新手，刚开始学习如何编写宏，所以任何关于我能做什么的反馈都将不胜感激。

https://www.contextures.com/exceltablemacrocopyitems.html

Sub CopySelectionVisibleRowsEnd()
Dim ws As Worksheet
Dim mySel As Range
Dim lRow As Long
Dim lRowNew As Long
Dim lRowsAdd As Long
Dim myList As ListObject
Dim myListRows As Long
Dim myListCols As Long

Set ws = ActiveSheet
Set mySel = Selection.EntireRow
Set myList = ActiveCell.ListObject
myListRows = myList.Range.Rows.Count
myListCols = myList.Range.Columns.Count
lRow = ws.Cells.Find(What:="*", _
        SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, _
        LookIn:=xlValues).Row + 1

mySel.SpecialCells(xlCellTypeVisible).Copy
ws.Cells(lRow, 1).PasteSpecial Paste:=xlPasteAll

lRowNew = ws.Cells.Find(What:="*", _
        SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, _
        LookIn:=xlValues).Row + 1
lRowsAdd = lRowNew - lRow

With myList
    .Resize ws.Range(.Range.Resize(myListRows + lRowsAdd, myListCols).Address)
End With

Application.CutCopyMode = False
End Sub

标签： excelvbacopy-paste

解决方案

如果您总是只想复制最后 4 列，试试这个。根据需要调整表名。

Sub CopySelectionVisibleRowsEnd()

Dim myList As ListObject
Dim rng As Range
Dim myListCols As Long

Set myList = ActiveSheet.ListObjects("Table1")
myListCols = myList.Range.Columns.Count
Set rng = Range("Table1[#All]").Resize(, myListCols + 4)
myList.Resize rng

myList.ListColumns(myListCols - 3).Range.Resize(, 4).Copy myList.ListColumns(myListCols + 1).Range

End Sub

推荐阅读