Goodday
Post on your forum are very helpful - today I needs some help with something that I cant find on the web.
I need to copy data in a table and add it as new rows in the same table. I then need to change the year date to a new date for eg. from 2019 tot 2020. (So in the end I have to ranges the original 2019 range and the new range 2020)
I found the macro to copy and add the data in the table posted on the website www.contextures.com. It does exactly what I want to do (the macro is below). I now need to change the year to the next year. Mostly it will be just say from 2019 to 2020 and the next time it will be from 2020 to 2021 depending on the year I am working with. Or it must be based on a cell value (that will be maybe better because one can skip a year if needed for eg going from 2019 tot 2021)
It there is not a lot of data in in the table it is easy to use find and replace but once the data gets more its going to be difficult and one is going to get confused with the year ranges.
I attached a sample range and hope someone can help me to complete the macro with the find and replace. I will need to use the same function on different tables in the workbook.
Thanks for the help.
Regards
Ramonde
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
Post on your forum are very helpful - today I needs some help with something that I cant find on the web.
I need to copy data in a table and add it as new rows in the same table. I then need to change the year date to a new date for eg. from 2019 tot 2020. (So in the end I have to ranges the original 2019 range and the new range 2020)
I found the macro to copy and add the data in the table posted on the website www.contextures.com. It does exactly what I want to do (the macro is below). I now need to change the year to the next year. Mostly it will be just say from 2019 to 2020 and the next time it will be from 2020 to 2021 depending on the year I am working with. Or it must be based on a cell value (that will be maybe better because one can skip a year if needed for eg going from 2019 tot 2021)
It there is not a lot of data in in the table it is easy to use find and replace but once the data gets more its going to be difficult and one is going to get confused with the year ranges.
I attached a sample range and hope someone can help me to complete the macro with the find and replace. I will need to use the same function on different tables in the workbook.
Thanks for the help.
Regards
Ramonde
| Copy data.xlsm | ||||||
|---|---|---|---|---|---|---|
| A | B | C | D | |||
| 3 | Year | Cary over | Own / Rented | Farm Name | ||
| 4 | 2019 | Ja | Eie | Harmonie | ||
| 5 | 2019 | Ja | Eie | Mizpah | ||
| 6 | 2019 | Ja | Eie | Mybou | ||
| 7 | 2019 | Ja | Eie | Blackwood | ||
| 8 | 2019 | Ja | Eie | Vanstadensdrif | ||
| 9 | 2019 | Ja | Eie | SG/KV | ||
| 10 | 2019 | Ja | Eie | Paradyskloof | ||
| 11 | 2019 | Ja | Eie | Rooderand | ||
Sheet1 | ||||||
| Cells with Data Validation | ||
|---|---|---|
| Cell | Allow | Criteria |
| B4:B11 | List | =Ja |
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
