[已解决]如何将统一文件夹内多个excel工作表数据导入到汇总表？

wdqinweiyu · 发表于 2014-5-14 15:28

在平时工作中，发现要核对数据的时候，要将所有分表的数据进行复制粘贴后汇总，每次都要粘贴30多个，是否可以通过代码执行，一键汇总入一个表？

hwc2ycy · 发表于 2014-5-14 15:30

grf1973 · 发表于 2014-5-14 16:04

Sub 汇总()
Application.ScreenUpdating = False
Dim filename, shtname As String, wb As Workbook, Sht As Worksheet, fn As String, arr
filename = Dir(ThisWorkbook.Path & "\*.xls")
Set sh1 = Sheets("缴费成功"): Set sh2 = Sheets("扣缴失败")
Do While filename <> ""
If filename <> ThisWorkbook.Name Then
fn = ThisWorkbook.Path & "" & filename
Set wb = Workbooks.Open(fn)
wb.Worksheets("成功").UsedRange.Copy sh1.Cells(sh1.[a65536].End(3).Row + 1, 1)
wb.Worksheets("失败").UsedRange.Copy sh2.Cells(sh2.[a65536].End(3).Row + 1, 1)
wb.Close False
End If
filename = Dir
Loop
Set Sht = Nothing
Application.ScreenUpdating = True
End Sub

复制代码

526753064 · 发表于 2014-5-14 16:11

Sub 汇总表格()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
If .Show = -1 Then
'定义单个文件变量
Dim vrtSelectedItem As Variant
'定义循环变量
Dim i As Integer
i = 1
'开始文件检索
For Each vrtSelectedItem In .SelectedItems
'打开被合并工作簿
Dim tempwb As Workbook
Set tempwb = Workbooks.Open(vrtSelectedItem)
'定义循环变量
Dim a, b, c, d
a = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
b = ThisWorkbook.Sheets(3).Cells(Rows.Count, 1).End(xlUp).Row + 1
c = tempwb.Sheets("成功").Cells(Rows.Count, 1).End(xlUp).Row + 1
d = tempwb.Sheets("失败").Cells(Rows.Count, 1).End(xlUp).Row + 1
If c > 0 Then ThisWorkbook.Sheets(1).Cells(a, 1).Resize(c, 14) = tempwb.Sheets("成功").Range("a1:n" & c).Value
If d > 0 Then ThisWorkbook.Sheets(3).Cells(b, 1).Resize(d, 14) = tempwb.Sheets("失败").Range("a1:n" & d).Value
tempwb.Close SaveChanges:=False
i = i + 1
Next vrtSelectedItem
End If
End With
'
End Sub

复制代码

记得先把汇总单元格设置成文本格式，身份证号会出错的

grf1973 · 发表于 2014-5-14 16:18

请看附件。

qh8600 · 发表于 2014-5-14 16:50

为什么数据不同一放在一个表中呢

ppp710715 · 发表于 2014-5-14 16:52

Sub 汇总表格()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
ThisWorkbook.Activate
Sheets(1).Range("d:d,f:f,L:L").NumberFormatLocal = "@"
Sheets(2).Range("d:d,f:f,L:L").NumberFormatLocal = "@"
Sheets(2).[a1].Resize(1, 15) = Array("序号", "个人编号", "姓名", "身份证号码", "性别", "银行账号", "缴费年月", _
"缴费金额", "参保类型", "地址", "村社", "机构码", "成功标志", "扣款时间", "乡镇")
With fd
If .Show = -1 Then
'定义单个文件变量
Dim vrtSelectedItem As Variant
'定义循环变量
Dim i As Integer
i = 1
'开始文件检索
For Each vrtSelectedItem In .SelectedItems
'打开被合并工作簿
Dim tempwb As Workbook
Set tempwb = Workbooks.Open(vrtSelectedItem)
'定义循环变量
Dim a, b, c, d
a = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
b = ThisWorkbook.Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1
c = tempwb.Sheets("成功").Cells(Rows.Count, 1).End(xlUp).Row + 1
d = tempwb.Sheets("失败").Cells(Rows.Count, 1).End(xlUp).Row + 1
If c > 0 Then ThisWorkbook.Sheets(1).Cells(a, 1).Resize(c, 14) = tempwb.Sheets("成功").Range("a1:n" & c).Value
If d > 0 Then ThisWorkbook.Sheets(2).Cells(b, 1).Resize(d, 14) = tempwb.Sheets("失败").Range("a1:n" & d).Value
tempwb.Close SaveChanges:=False
i = i + 1
Next vrtSelectedItem
End If
End With
End Sub

复制代码

qh8600 · 发表于 2014-5-14 17:58

既然每次要合并为什么不做在一起

wdqinweiyu · 发表于 2014-5-15 09:00

因为每次都要分开上传系统，合并是为了汇总和核对。

ZZCUEEI · 发表于 2015-12-17 09:23

学习

		自动登录	找回密码
密码			注册