Copy Tables to various tabs and Export to Powerpoint

chi05

New member
Joined
Jun 25, 2015
Messages
8
Reaction score
0
Points
0
I need a macro that can extract tables from the attached spreadsheet (Worksheet name is Trial_Sheet and sheet name is “sample”) and create multiple tabs with Tab names as the first element of the table and copy the individual tables to separate worksheets as shown in the attached workbook. The first elements from the tables are Table1, Table2, Table3 and Table4.

Please note that in the actual spreadsheet the amount of table are not known. It could be up to 50 tables arranged in no particular order except spaces between the table (I think CurrentRegion should work but not sure) Is this possible?

Once this has been achieved can it export the contents of the various tabs except the “sample” tab to a PowerPoint?
Thank you so much for the help.
 

Attachments

  • Trial_Sheet.xlsx
    17.1 KB · Views: 11
A short code that works with your sample file (delete all your Tablen sheets first):
Code:
Sub blah()
For Each are In Range("A1").SpecialCells(xlCellTypeConstants, 23).Areas
  With Sheets.Add(after:=Sheets(Sheets.Count))
    are.Copy .Range("B2")
    .Name = are.Cells(1, 1).Value
  End With
Next are
End Sub
but this requires that there are no formulae in the tables at all.


A more inclusive technique looks for formulae and constant values in the cells (and won't crash if the sheet is empty):
Code:
Sub blah2()
Dim FormulaAreas As Range, myAreas As Range

On Error Resume Next
Set myAreas = Range("A1").SpecialCells(xlCellTypeConstants, 23)
Set FormulaAreas = Range("A1").SpecialCells(xlCellTypeFormulas, 23)
On Error GoTo 0

If myAreas Is Nothing Then
  If Not FormulaAreas Is Nothing Then Set myAreas = FormulaAreas
Else
  If Not FormulaAreas Is Nothing Then Set myAreas = Union(myAreas, FormulaAreas)
End If

If Not myAreas Is Nothing Then
  For Each are In myAreas.Areas
    With Sheets.Add(after:=Sheets(Sheets.Count))
      are.Copy .Range("B2")
      .Name = are.Cells(1, 1).Value
    End With
  Next are
End If
End Sub

Both codes work on the active sheet so make sure that the Sample sheet is the active one when running.
Neither of them check that the top left cell of each table contains a valid sheet name.
Both codes rely on the fact that the original tables are surrounded by blank cells or the edge of the sheet (like the CurrentRegion you suggest).

I haven't addressed the PowerPoint bit yet; would it be OK if you could get the separate tables into PowerPoint without adding new sheets?
Do you want to link the tables in PowerPoint to the excel ranges (tables) or import the data into PowerPoint without a link, embed a spreadsheet object? Perhaps a picture?
Your question wasn't too specific about those points.
 
Last edited:
or

Code:
Sub M_snb()
    For Each ar In Sheets("sample").Cells.SpecialCells(2).Areas
       Sheets.Add(, Sheets(Sheets.Count)).Cells(1).Resize(ar.Rows.Count, ar.Columns.Count) = ar.Value
    Next
End Sub
 
What if I have spaces in the table..

Thanks guys what if there are spaces in the table as shown in the attached sheet. How can I modify the code to take care of the spaces for me? Thanks in advance!
 

Attachments

  • Trial_Sheet2.xlsx
    17.6 KB · Views: 10
If possible I will like to have a separate code that can get the separate tables into PowerPoint without adding new sheets. Thanks a lot guys!
 
Last edited:
try:
Code:
Sub blah3()
Dim myArea As Range
For Each are In Range("A1").SpecialCells(xlCellTypeConstants, 23).Areas
  If myArea Is Nothing Then Set myArea = are.CurrentRegion Else Set myArea = Union(myArea, are.CurrentRegion)
Next are
For Each are In myArea.Areas
  With Sheets.Add(after:=Sheets(Sheets.Count))
    are.Copy .Range("B2")
    .Name = are.Cells(1).Value
  End With
Next are
End Sub
 
If possible I will like to have a separate code that can get the separate tables into PowerPoint without adding new sheets. Thanks a lot guys!
again: Do you want to link the tables in PowerPoint to the excel ranges (tables) or import the data into PowerPoint without a link, embed a spreadsheet object? Perhaps a picture?
Your question wasn't too specific about those points.
 
Thanks p45cal for the help I want to embed a spreadsheet object in Powerpoint, i hope that helps to explain it.
 
p45cal....I posted on this forum because I couldn't get help on the powerpoint section. I forgot to post the link of my previous forum and I am sorry about that. Also I joined this forum because my work computer security features could not open the excelforum.com due to maleware associated with the website. So for me to post on excelforum I have to wait till I get back home to use my personal computer otherwise I could not access it from work. I hope that explains it. Thanks for the help. I was told to ask someone for help on the PowerPoint section on how to embed a spreadsheet object to Powerpoint. But if it is easier to link the tables in PowerPoint to excel ranges I will prefer that method also.
Thanks for your understanding.
 
Are you asking for a solution or for help to create your own ?
 
I was finally able to get what I am looking for...thanks guys
 
Back
Top