Скопируйте и вставьте выбранные столбцы в конец таблицы в Excel с VBA

Question

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

Answer 1

Если вы всегда хотите скопировать только последние 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