|
最近在研究学习VBA,个人想将指定文件夹下里面的文件名与对应的列内容全部复制到一张表上,目前代码可以实现将文件名按列分布到一张表上,但是文件夹里面的指定内容无法完成复制粘贴工作,有高人指点下吗?
* 文件名汇总复制代码
Private Sub CommandButton1_Click()
Dim fso As New FileSystemObject
Dim r As Integer, path As String
Set f = fso.GetFolder("D:\移动桌面\CSP数据")
Worksheets("数据").Select
r = Cells(1, Columns.Count).End(xlToLeft).Column 'r = Cells(2, Columns.Count).End(xlToLeft).Column
For Each wjm In f.Files
If wjm.Name Like "*.csv" Then
Cells(1, r) = Left(wjm.Name, Len(wjm.Name) - 4) 'Left(wjm.Name, Len(wjm.Name) - 4)省略文件格式
r = r + 1
End If
Next
Set fso = Nothing
End Sub
- Sub 导入文件()
- Application.ScreenUpdating = False
- Dim Filename, wb As Workbook, Sht As Worksheet, xRng As Range
- Filename = Dir(ThisWorkbook.path & "\*.csv")
- With ActiveSheet
- .Cells.Clear
- Do While Filename <> ""
- fn = ThisWorkbook.path & "" & Filename
- Set wb = Workbooks.Open(fn)
- Set Sht = wb.Worksheets(1)
- n = n + 1
- .Cells(1, n) = Split(wb.Name, ".")(0)
- Set xRng = Sht.UsedRange.Find("RANK", lookat:=xlWhole)
- If Not xRng Is Nothing Then
- rmax = Sht.Cells(65536, xRng.Column).End(3).Row
- Sht.Range(xRng, Sht.Cells(rmax, xRng.Column)).Copy Cells(11, n)
- End If
- wb.Close False
- Filename = Dir
- Loop
- End With
- Application.ScreenUpdating = True
- End Sub
复制代码
|
|