如何用宏提取在一个文件夹中的多个EXCEL表格中的相同位置的数据
例如我有一个文件夹,里面有三个文件名分别为1,2,3。我需要提取每个表格sheet1中的数据A1。如何用宏批量完成。...
例如我有一个文件夹,里面有三个文件名分别为1,2,3。我需要提取每个表格sheet1中的数据A1。如何用宏批量完成。
展开
展开全部
5.XSL,右键sheet1——查看代码——粘贴代码——运行代码
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
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
追问
怎样不需要一个一个写文件名,直接把文件夹内的所有excel的信息都提取到。
另外这段代码哪里体现我需要的A1的单元格?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询