Excel工作薄合并求教

yoyofengfeng · 发表于 2009-11-11 18:29

问题: 面料采购,有二十几家配合的工厂,每个工厂我自己做了一个跟单表,格式都是一样的,希望大侠赐教如何把这二十几家面料厂的订单情况汇总到一张表格里,或者这张大表里有更新能在分表里同步更新,反之亦然呢~~~

如下上传两个面料厂的跟单表,请赐教!!! 万分感激!!!

xinjiana · 发表于 2009-11-12 10:04

看到英文就头疼，可耻的匿了

yoyofengfeng · 发表于 2009-11-12 16:37

原帖由 xinjiana 于 2009-11-12 10:04 发表
看到英文就头疼，可耻的匿了

不好意思呀,工作需要用英文,能帮帮忙吗? 在线等

xxb520 · 发表于 2009-11-12 18:04

转自：http://hi.baidu.com/basehue/blog ... 38a62eddd40c%2Ehtml

源网页里有两个下载地址，xla的后缀文件，要用“工具”下的“加载宏”来加载运行。

//*
此宏用于合并同一工作簿内的所有工作表！
打开你的工作簿，按下alt+F11，插入-模块，看见一个模块1，复制下面的的内容，然后运行。
你的工具-宏-安全性，设置为中，才能运行此宏。
按照提示做就可以了。注意：如果工作表很多可能需要很长时间，请耐心等待！
*//
==========以下是宏===============

Sub 合并各工作表内容()
sp = InputBox("各表内容之间，间隔几行？不输则默认为0")
If sp = "" Then
  sp = 0
End If

st = InputBox("各表从第几行开始合并？不输则默认为2")
If st = "" Then
st = 2
End If

Sheets(1).Select
Sheets.Add

  If st > 1 Then
Sheets(2).Select
Rows("1:" & CStr(st - 1)).Select
Selection.Copy
Sheets(1).Select
Range("A1").Select
ActiveSheet.Paste
  y = st - 1
  End If

For i = 2 To Sheets.Count

  Sheets(i).Select
   For v = 1 To 256
      zd = Cells(65535, v).End(xlUp).Row
      If zd > x Then
         x = zd
      End If
   Next v

  If y + x - st + 1 + sp > 65536 Then
  MsgBox "内容太多，仅合并前" & i - 2 & "个表的内容，请把其它表复制到新工作薄里再用此程序合并！"
  Else:

  Rows(st & ":" & x).Select
  Selection.Copy
  Sheets(1).Select
  Range("A" & CStr(y + 1)).Select
  ActiveSheet.Paste

  Sheets(i).Select
  Range("A1").Select
  Application.CutCopyMode = False
  End If

  y = y + x - st + 1 + sp
  x = 0
Next i

Sheets(1).Select
Range("A1").Select
MsgBox "这就是合并后的表，请命名！"

End Sub

xxb520 · 发表于 2009-11-12 18:11

这个需要你把所有的工作表放在一个工作簿里！

yoyofengfeng · 发表于 2009-11-13 15:29

非常感谢 xxb520!你真的是帮了我的大忙了!!! 谢谢啊

我试了一下,可以的!!!

但是唯一的不足是要把工作表放在一个工作薄里,有什么办法直接把同一文件夹下的各个工作薄里的工作表合并吗?? 不好意思,有点贪心

xxb520 · 发表于 2009-11-17 20:08

Sub 将同路径下的多张工作薄中的工作表合并到当前活动的工作表()
Application.ScreenUpdating = False
Dim lj, dirname, nm
Dim a As Long
Dim i As Long
lj = ThisWorkbook.Path
nm = ThisWorkbook.Name
dirname = Dir(lj & "\*.xls")
Do While dirname <> ""
      If dirname <> nm Then
         Workbooks.Open Filename:=lj & "\" & dirname
         a = Sheets.Count  '读当前工作薄中的所有的工作表
         Workbooks(nm).Activate
         For i = 1 To a
            Workbooks(dirname).Sheets(i).UsedRange.Copy Range("a65536").End(xlUp).Offset(2, 0) '复制新打开的工作簿的第一个工作表的已用区域到rng
         Next i
         Workbooks(dirname).Close False
      End If
      dirname = Dir
Loop

End Sub

xxb520 · 发表于 2009-11-17 20:10

彭希仁大大的我只是CTRL+C CTRL+V

http://club.excelhome.net/viewth ... %26amp%3Btypeid%3D7

wf320722 · 发表于 2009-11-17 20:52

是不是通用的？

xxb520 · 发表于 2009-11-18 07:39

是通用的！

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

[求助] Excel工作薄合并求教