StillUnderstanding
Board Regular
- Joined
- Jan 30, 2021
- Messages
- 80
- Office Version
- 365
- Platform
- Windows
- MacOS
Hello,
It would be great if someone amazing might be able to help me to work this out!
So I have a spreadsheet that we use in Teams and I am trying to merge a load of data from about 30 tabs into a "Consolidate Data" tab, the problem I am having is that the action of deleting the tab and recreating it is resulting in the other user of the sheet having to reopen it.
It looks like Teams cant handle having 5 users in the workbook at the same time with one user deleting and creating tabs.
Here is the code that I am using:
I guess what I am wanting to do it to be able to clear the Consolidate Data tab rather than delete and recreate, I am just not too sure how to do it.
Any and all help is appreciated!
Thanks
It would be great if someone amazing might be able to help me to work this out!
So I have a spreadsheet that we use in Teams and I am trying to merge a load of data from about 30 tabs into a "Consolidate Data" tab, the problem I am having is that the action of deleting the tab and recreating it is resulting in the other user of the sheet having to reopen it.
It looks like Teams cant handle having 5 users in the workbook at the same time with one user deleting and creating tabs.
Here is the code that I am using:
VBA Code:
Sub Consolidate_Data_From_Different_Sheets_Into_Single_Sheet()
'Procedure to Consolidate all sheets in a workbook
On Error GoTo IfError
'1. Variables declaration
Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstRow As Long
Dim i As Integer, EnRange As String
Dim SrcRng As Range
'2. Disable Screen Updating - stop screen flickering
' And Disable Events to avoid inturupted dialogs / popups
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'3. Delete the Consolidate_Data WorkSheet if it exists
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidate_Data").Delete
Application.DisplayAlerts = True
'4. Add a new WorkSheet and name as 'Consolidate_Data'
With ActiveWorkbook
Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
DstSht.Name = "Consolidate_Data"
End With
'5. Loop through each WorkSheet in the workbook and copy the data to the 'Consolidate_Data' WorkSheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "IT Equipment Tracker" And Sht.Name <> DstSht.Name And Sht.Name <> "Master" Then
'5.1: Find the last row on the 'Consolidate_Data' sheet
DstRow = fn_LastRow(DstSht)
'5.2: Find Input data range
LstRow = fn_LastRow(Sht)
LstCol = fn_LastColumn(Sht)
EnRange = Sht.Cells(LstRow, LstCol).Address
Set SrcRng = Sht.Range("A7:" & EnRange)
'5.3: Check whether there are enough rows in the 'Consolidate_Data' Worksheet
If DstRow + SrcRng.Rows.Count > DstSht.Rows.Count Then
MsgBox "There are not enough rows to place the data in the Consolidate_Data worksheet."
GoTo IfError
End If
'5.4: Copy data to the 'consolidated_data' WorkSheet
SrcRng.Copy Destination:=DstSht.Range("A" & DstRow + 1)
End If
Next
Sheets("Template to copy").Select
Range("A6").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Sheets:=38
Sheets("Consolidate_Data").Select
Range("A1").Select
ActiveSheet.Paste
IfError:
'6. Enable Screen Updating and Events
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$BD$2500"), , xlYes).Name _
= "Table8"
Range("Table8[#All]").Select
ActiveWindow.Zoom = 70
ActiveSheet.ListObjects("Table8").Range.AutoFilter Field:=1, Criteria1:="="
Rows("20:20").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ListObjects("Table8").Range.AutoFilter Field:=1
End Sub
'In this example we are finding the last Row of specified Sheet
Function fn_LastRow(Sht As Worksheet)
Dim lastRow As Long
lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
lRow = Sht.Cells.SpecialCells(xlLastCell).Row
Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
lRow = lRow - 1
Loop
fn_LastRow = lRow
End Function
'In this example we are finding the last column of specified Sheet
Function fn_LastColumn(Sht As Worksheet)
Dim lastCol As Long
lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
Lcol = Sht.Cells.SpecialCells(xlLastCell).Column
Do While Application.CountA(Sht.Columns(Lcol)) = 0 And Lcol <> 1
Lcol = Lcol - 1
Loop
fn_LastColumn = Lcol
End Function
I guess what I am wanting to do it to be able to clear the Consolidate Data tab rather than delete and recreate, I am just not too sure how to do it.
Any and all help is appreciated!
Thanks