(vba)用于将大表差分成若干个小表的脚本

帮朋友写的一个小脚本。自己组织了下说明文字，存起来以后用。

’将类似如下的表拆

序号 名称 超市1价格 超市2价格

1     水果   23               45

2     蔬菜   34                45

拆分后  超市1价格.xls

名称 超市1价格

1      水果 23

2     蔬菜   34 

Sub spi()

 

   Dim wk As Workbook

   Dim rangeJZ As Range

   Dim rangeCZ As Range

   Dim cell As Range

   Dim strCellCol As String

   Dim strTableName As String

   

   For Each cell In Range("C1:BK1")

       strTableName = "c:\temp_" & cell.Text

       Set wk = Workbooks.Add

       

       strCellCol = Split(cell.Address, "$")(1)

       

       Windows("201112客流监视_分站速报.xlsx").Activate

       Sheets("进站").Range("A:B," & strCellCol & ":"& strCellCol).Copy

       wk.Activate

       wk.Sheets.Item(1).Activate

       ActiveSheet.Paste

       

       

       Windows("201112客流监视_分站速报.xlsx").Activate

       Sheets("出站").Range("A:B," & strCellCol & ":"& strCellCol).Copy

       wk.Activate

       wk.Sheets.Item(2).Activate

       ActiveSheet.Paste

      

       wk.Sheets("Sheet1").Name = "进站"

       wk.Sheets("Sheet2").Name = "出站"

       

       wk.SaveAs Filename:= _

           "c:\" & cell.Text & ".xlsx", FileFormat:= _

           xlOpenXMLWorkbook, CreateBackup:=False

       wk.Close

       

       'Exit For

   Next

 

End Sub