Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2292|回复: 1

用excel VBA怎么把多个工作簿里的两列数据按名称对应复制到一个工作簿对应的列里

[复制链接]
发表于 2017-9-26 11:21 | 显示全部楼层 |阅读模式
各位大师,我现在每个月要整理一张表, 这张表的列抬头是地区名,然后基础数据是从每个地区的年度表内取当月两列数,所以每个月都要复制黏贴无数次,想让哪位高人给写个VBA代码能实现的。以7月江苏分公司为例,我需要复制基础表中江苏分公司的N6:O131到总执行表中的B5:C130。数据太多,只放了部分分公司基础表做测试。急急急,在线等!谢谢大家了!

分公司月汇总.rar

452.95 KB, 下载次数: 2

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2017-10-10 10:22 | 显示全部楼层
  1. Sub test1()
  2. Application.ScreenUpdating = False
  3. Dim aw, t, k, br, s
  4. Dim rg As Range, wk As Workbook
  5. Set aw = ThisWorkbook
  6.       '以下遍历文件,提取各公司数据
  7.     p = aw.Path & ""
  8.     f = Dir(p & "*.xls")
  9.     Do While f <> ""
  10.     If f <> ThisWorkbook.Name Then
  11.         Set wk = GetObject(p & f)
  12.         wk.Sheets(1).Activate
  13.         t = InStr(wk.Name, ".")
  14.         s = Left(wk.Name, t - 1)
  15.         aw.Activate
  16.         q = ActiveSheet.Name
  17.         wk.Sheets(1).Activate
  18.                 Set rg = wk.Sheets(1).[4:4].Find(q)
  19.                 If Not rg Is Nothing Then
  20.                    k = rg.Column
  21.                    br = wk.Sheets(1).Range(Cells(6, k), Cells(131, k + 1)).Value
  22.                    Else
  23.                    MsgBox ActiveSheet.Name & "的数据未找到!"
  24.                 End If
  25.            aw.Activate
  26.                 Set rg = ActiveSheet.[3:3].Find(s)
  27.                 If Not rg Is Nothing Then
  28.                    k = rg.Column
  29.                    ActiveSheet.Range(Cells(5, k), Cells(130, k + 1)) = br
  30.                    Else
  31.                    MsgBox ActiveSheet.Name & "的数据未找到!"
  32.                 End If
  33.                    wk.Close False
  34.     End If
  35.         f = Dir
  36.         Loop
  37. Application.ScreenUpdating = True
  38. MsgBox "数据汇总完毕!"
  39. End Sub
复制代码

打开总执行表,按汇总按钮即可。其他表不用打开。
分公司月汇总.rar (465.3 KB, 下载次数: 5)
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-6-13 11:04 , Processed in 0.286379 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表