有几百个excel文件的数据需要导入到一个excel中 查了下其他人的代码,我修改了下,但是不行 哪位高手能帮帮忙啊,多谢了 附件中CZ是目标文件,其他的是数据源(有几百个这样的文件) 需要将源数据中的 A2:D26导入到目标文件 如果源数据名称的最后一位是1就写入目标文件的sheets(1) , 类推 2, 3 多谢啦 问题自己解决了 非常感谢夜兄的帮忙 我的代码: Private Sub CommandButton2_Click() Dim myDialog As FileDialog, oFile As Object, strName As String, n As Integer Dim FSO As Object, myFolder As Object, myFiles As Object Dim fn$ Set myDialog = Application.FileDialog(msoFileDialogFolderPicker) n = 1 With myDialog If .Show <> -1 Then Exit Sub Set FSO = CreateObject("Scripting.FileSystemObject") '这是文件夹选择,点选到你存放文件的那个 Set myFolder = FSO.GetFolder(.InitialFileName) Set myFiles = myFolder.Files a = 3 b = 3 c = 3 For Each oFile In myFiles strName = UCase(oFile.Name) strName = VBA.Right(strName, 3) If strName = "xls" Or strName = "XLS" Then '这是扩展名选择 '下面就可接着写打开文件读取数据再写入的语句了,如下: fn = myFolder & "\" & oFile.Name Workbooks.Open Filename:=fn k = Mid(oFile.Name, Len(oFile.Name) - 4, 1) * 1 Application.ScreenUpdating = False Select Case k Case 1 For i = 1 To 24 For j = 1 To 4 Workbooks(1).Sheets(k).Cells(a + i, j) = Workbooks(2).Sheets(1).Cells(i + 2, j) Next Next a = a + 24 Case 2 For i = 1 To 24 For j = 1 To 4 Workbooks(1).Sheets(k).Cells(b + i, j) = Workbooks(2).Sheets(1).Cells(i + 2, j) Next Next b = b + 24 Case Else For i = 1 To 24 For j = 1 To 4 Workbooks(1).Sheets(k).Cells(c + i, j) = Workbooks(2).Sheets(1).Cells(i + 2, j) Next Next c = c + 24 End Select Application.ScreenUpdating = True Workbooks(2).Close n = n + 1 End If Next End With End Sub [ 本帖最后由 XIEShichen 于 2009-9-10 20:57 编辑 ] |
|