VBA help - copy cells from specific table to specific table on another sheet.

GardianAngelUK

New Member
Joined
Mar 6, 2024
Messages
1
Office Version
  1. 2016
Platform
  1. Windows
I am trying to set up a workbook that tracks daily workloads across 6 teams. each day has its own sheet and on each sheet, each team have their own table.

I would like a button on each sheet to transfer rows that haven't been approved or rejected (each table has a column called Approve/Reject and has 3 states, Approved, Rejected or Blank) into its counterpart table on the next day's sheet.

For ease we shall use generic naming Sheet 1, sheet 2 etc.. and table 1, table 2 etc.

So to be clear i have 7 sheets, on each sheet there is 6 tables which means first table on sheet 2 will be called table7.

Being new to VBA coding I decided to break it down into steps and the have a single macro that runs each macro one after the other so i have managed to come up with the macros towards the bottom of this question, which almost does what i need so long as each table has at least one row that hasn't been approved or rejected. Some code is copy and pasted then adapted and other is created using the recorder then adapted. so likely can be done a lot easier.

My issue is that when a table has all its rows either approved or rejected then the filter the macros put on don't work so it tries to copy over all the rows which is not what i want. I also want to only copy over a day at a time.

Plus info may have already been inserted into the next day's table which my current method overwrites so could do with sorting that too if that is possible.

Hopefully i have explained my issue as best as i can but please ask for any other info you may need so can anyone help me as I'm lost and cannot figure it out?

VBA Code:
Sub Sunaddrows()

'This macro adds a defined amount of rows to each table on the next days tables.

Sheets("Sheet 1").Select

Dim ws As Worksheet: Set ws = ActiveSheet

Dim i As Long, x As Long

Dim Tbl As ListObject

Dim NewRow As ListRow

i = Sheets("Hidden sheet").Range("I4").Value ' this cell is on a normally hidden sheet and relates to a cell containing formula =COUNTBLANK(Table1[Approve/Reject]) which dictates how many rows to add

Set Tbl = ws.ListObjects(1)

For x = 1 To i

Set NewRow = ws.ListObjects("Table7").ListRows.Add(AlwaysInsert:=True)

Next x

i = Sheets("Hidden sheet").Range("I5").Value

Set Tbl = ws.ListObjects(1)

For x = 1 To i

Set NewRow = ws.ListObjects("Table8").ListRows.Add(AlwaysInsert:=True)

Next x

i = Sheets("Hidden sheet").Range("I6").Value

Set Tbl = ws.ListObjects(1)

For x = 1 To i

Set NewRow = ws.ListObjects("Table9").ListRows.Add(AlwaysInsert:=True)

Next x

i = Sheets("Hidden sheet").Range("I7").Value

Set Tbl = ws.ListObjects(1)

For x = 1 To i

Set NewRow = ws.ListObjects("Table10").ListRows.Add(AlwaysInsert:=True)

Next x

i = Sheets("Hidden sheet").Range("I8").Value

Set Tbl = ws.ListObjects(1)

For x = 1 To i

Set NewRow = ws.ListObjects("Table11").ListRows.Add(AlwaysInsert:=True)

Next x

i = Sheets("Hidden sheet").Range("I9").Value

Set Tbl = ws.ListObjects(1)

For x = 1 To i

Set NewRow = ws.ListObjects("Table12").ListRows.Add(AlwaysInsert:=True)

Next x

End Sub

Sub SunfilterON()

' This macro adds filter where it hides all approved and rejected rows (well its supposed too) but i believe this is the step that needs work

Sheets("Sheet 1").Select

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=4, _

Criteria1:="="

ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=4, Criteria1:= _

"="

ActiveSheet.ListObjects("Table3").Range.AutoFilter Field:=4, _

Criteria1:="="

ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=4, _

Criteria1:="="

ActiveSheet.ListObjects("Table5").Range.AutoFilter Field:=4, Criteria1 _

:="="

ActiveSheet.ListObjects("Table6").Range.AutoFilter Field:=4, _

Criteria1:="="

End Sub

Sub SunfilterOff()

'

' Turns off the above filters

'

'

Sheets("Sheet 1").Select

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=4

ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=4

ActiveSheet.ListObjects("Table3").Range.AutoFilter Field:=4

ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=4

ActiveSheet.ListObjects("Table5").Range.AutoFilter Field:=4

ActiveSheet.ListObjects("Table6").Range.AutoFilter Field:=4

End Sub

Sub Suntransfer()

'

' This is the copy and paste step originally created using recorder and then adapted slightly so does have unnecessary rows but I'm scared of braking what is currently working so left it as it is.

'

'

Application.Goto Reference:="Table1"

Selection.copy

Sheets("Sheet 2").Select

Range("Table7").Select

ActiveSheet.Paste

Application.Goto Reference:="Table2"

Application.CutCopyMode = False

Selection.copy

Sheets("Sheet2").Select

Range("Table8").Select

ActiveSheet.Paste

Application.Goto Reference:="Table3"

Application.CutCopyMode = False

Selection.copy

Sheets("Sheet2").Select

Range("Table9").Select

ActiveSheet.Paste

Application.Goto Reference:="Table4"

Application.CutCopyMode = False

Selection.copy

Sheets("Sheet2").Select

Range("Table10").Select

ActiveSheet.Paste

Sheets("Sheet2").Select

Application.Goto Reference:="Table5"

Application.CutCopyMode = False

Selection.copy

Sheets("Sheet2").Select

Range("Table11").Select

ActiveSheet.Paste

Application.Goto Reference:="Table6"

Application.CutCopyMode = False

Selection.copy

Sheets("Sheet2").Select

Range("Table12").Select

ActiveSheet.Paste

End Sub

Sub TransferSuntoMon()

' The actual macro that is attached to a button on each sheet

Call Sunrows

Call SunfilterON

Call Suntransfer

Call SunfilterOff

End Sub
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

Forum statistics

Threads
1,223,881
Messages
6,175,159
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top