CODEWITHSUNDEEP
excelvba
joehua
joehua

Reputation: 735

Programmatically detect the existence and size of tables then add them to another workbook

I have a workbook that crashes often. I suspect it's corrupted. So, I wrote the following code to copy it sheet by sheet to a new workbook. The size of the new workbook is now 40% less. Everything seems to work fine except the code doesn't copy tables. ListObjects doesn't seem to have a count property. So, it's not straight forward to detect the number of tables in a sheet.

How do I detect the existence, size, and location of tables? Once that info is known, I think it'd be quite easy to go to the target sheet and add tables. Thanks in advance for any help.

Sub copy_all()

'copy sheet by sheet from myworkbook.xlsb to the calling workbook

Dim rng As Range
Dim i As Integer

With Workbooks("myworkbook.xlsb")
For i = 1 To .Sheets.Count

Set rng = .Sheets(i).UsedRange

ThisWorkbook.Sheets(i).Range("A1").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
ThisWorkbook.Sheets(i).Range("A1").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Formula = rng.Cells.Formula
ThisWorkbook.Sheets(i).Range("A1").Resize(rng.Rows.Count, rng.Columns.Count).Cells.ColumnWidth = rng.Cells.ColumnWidth

rng.Copy
ThisWorkbook.Sheets(i).Range("A1").PasteSpecial Paste:=xlPasteFormats

ThisWorkbook.Sheets(i).Name = .Sheets(i).Name
ThisWorkbook.Sheets(i).Tab.ColorIndex = .Sheets(i).Tab.ColorIndex

Next i

End With

End Sub

Upvotes: 0

Views: 235

Answers (1)

FaneDuru
FaneDuru

Reputation: 42236

Try the next code, to find the ListObjects and their range address, please:

Sub testAllListObjects()
  Dim T As ListObject, sh As Worksheet
  
   For Each sh In ActiveWorkbook.Worksheets
      If sh.ListObjects.Count > 0 Then
         For Each T In sh.ListObjects
              Debug.Print sh.Name, T.Name, T.Range.address
         Next
      End If
   Next
End Sub

Upvotes: 1

Related Questions