Excel Table to Tabs

[balvy]

Hello everybody,

I have different tables and workbooks. In Sheet1 of every workbook i have a table that vary in the amount of columns. From this table I have to make a Sheet per column. In each Sheet the cells have to always be column 1 and then the corresponding column. For example:

Table1
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Items[/TD]
[TD]Price[/TD]
[TD]Area[/TD]
[TD]Color[/TD]
[TD]Date[/TD]
[/TR]
[TR]
[TD]shirt[/TD]
[TD]2.00[/TD]
[TD]up[/TD]
[TD]blue[/TD]
[TD]12-12-14[/TD]
[/TR]
[TR]
[TD]pants[/TD]
[TD]3.50[/TD]
[TD]down[/TD]
[TD]red[/TD]
[TD]12-11-14[/TD]
[/TR]
</tbody>[/TABLE]

here Sheet2 should be Items and Price, Sheet3 should be Items and Area, Sheet4 should be Items and Color and so on.

Is there anyway i can do this without having to be copying and pasting the columns one by one and be able to do it for different workbooks.

Thanks for all your help.

 

[shg]

One way:

Sub balvy()
  Dim wks1          As Worksheet
  Dim iCol          As Long
  Dim nCol          As Long

  Set wks1 = Worksheets(1)

  nCol = wks1.Cells(1, Columns.Count).End(xlToLeft).Column
  Do While nCol > Worksheets.Count
    Worksheets.Add After:=Sheets(Sheets.Count)
  Loop

  For iCol = 2 To nCol
    With Worksheets(iCol)
      wks1.Columns(1).Copy .Columns(1)
      wks1.Columns(iCol).Copy .Columns(2)
    End With
  Next iCol
End Sub

 

[Smitty]

You could do it with Pivot Tables.

 

[balvy]

Thanks this code is on point. Is there anyway to use the Table headings (Price, Area, Code...) as the names for the different worksheets? If there isn't it's ok you have been more than helpful.

 

[shg]

Sub balvyTwo()
  Dim wks1          As Worksheet
  Dim iCol          As Long
  Dim nCol          As Long

  Set wks1 = Worksheets(1)

  Application.DisplayAlerts = False
  Do While Worksheets.Count > 1
    Worksheets(2).Delete
  Loop
  Application.DisplayAlerts = True
  
  nCol = wks1.Cells(1, Columns.Count).End(xlToLeft).Column
  Do While Worksheets.Count < nCol
    Worksheets.Add After:=Sheets(Sheets.Count)
  Loop

  For iCol = 2 To nCol
    With Worksheets(iCol)
      .Name = wks1.Cells(1, iCol).Value
      wks1.Columns(1).Copy .Columns(1)
      wks1.Columns(iCol).Copy .Columns(2)
    End With
  Next iCol
End Sub

Note that it deletes all but the first sheet at the outset (to avoid a name conflict).