简体   繁体   中英

Copy and Paste Selected Columns to End of Table in Excel with VBA

Within the same worksheet I have a single table, and each time I add new data I need to copy the last 4 columns of this table to the right end of that same table so I can add new data. The main reason being I always want to keep the same format and some columns have dropdown lists and formulas.

I found the next code in the website below. It works really well for copy/pasting rows, so I tried to modify the code to do it for columns but I couldn´t manage.

I´m new to VBA and just starting to learn how to program macros, so any feedback on what I could do would be appreciated.

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

If you always want to copy just the last 4 columns, try this. Adjust table name as necessary.

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM