如何将excel工作薄中的单列数据复制到不同的新工作簿中

汇总报表中单列公司的数据要分发到下属公司,如果每一列都复制到新工作簿另存,工作很大,所以编写了一段VBA来代替重复的手工劳动
Sub add_new()
On Error Resume Next
With Worksheets("Detail line-consolidation") '汇总报表
For i = 3 To 35
Dim fname As String
fname = .Cells(3, i) '取公司名称
Dim mybook As Workbook
Set mybook = Workbooks.Add
mybook.SaveAs "d:\vba\" & fname & ".xls"
col = Split(Cells(3, i).Address, "$")(1) '取列名
.Range("a2:b169").Copy
Windows(fname & ".xls").Activate
Range("a1").PasteSpecial
.Range(col & "2:" & col & "169").Copy
Windows(fname & ".xls").Activate
Range("c1").PasteSpecial
Workbooks(fname & ".xls").Close savechanges:=True
Set mybook = Nothing
Next i
End With
End Sub

VBA中获取文件名的方法

在用excel做文件导入时发现,一旦使用Commond Dialogs 就会出错

“The control could not be created because it is not properly licensed”

原因是,Commond Dialogs are not licensed to be used in Excel。经过搜索发现,其实VBA还有其它的法子获得文件路径。

1
2
3
4
5
6
7
8
9
10
Private Function OpenDialog() As String
     Dim sFile As String
     Dim n As Integer
     '获取路径
     sFile = Application.GetOpenFilename("MS excel (*.xls), *.xls")  
     '获取文件title的长度
     n = Len(sFile) - InStrRev(sFile, "\") 
     '获得文件title
     tt = Right(sFile, n) 
End Function