VBA代码 代码库 ·

Excel宏提取在一个文件夹中的多个EXCEL表格中的相同位置的数据

Sub mysub()
Dim ShApp As Object, mysheet As Object
Dim TF As Boolean, i As Integer
Dim aTable As Object, n As Integer
On Error Resume Next
n = 0
With Application.FileDialog(msoFileDialogFilePicker)
       .Title = "请选定要处理的excel文档"
       .Filters.Add "excel文档", "*.xls"  '暂定扩展名为xls的excel文档
       .AllowMultiSelect = True
       If .Show <> -1 Then Exit Sub
       Set ShApp = GetObject(, "Excel.Application")
       If Err <> 0 Then
           TF = True
           Set ShApp = CreateObject("Excel.Application")
       End If
       Application.ScreenUpdating = False
       For i = 1 To .SelectedItems.Count
           Set mysheet = ShApp.Workbooks.Open(.SelectedItems(i))
                With mysheet.Sheets(1)
                     .[a8].Copy [a65536].End(xlUp).Offset(1)
                End With
                n = n + 1
           mysheet.Close True
       Next i
   End With
   If TF = True Then ShApp.Quit
   Set ShApp = Nothing
   MsgBox "处理完毕,共处理了" & n & "个excel文档。"
   Application.ScreenUpdating = True
End Sub

使用方式:右键sheet1——查看代码——粘贴代码——运行代码(如有需要可以自行修改!)