大佬们，跨工作簿进行数据的粘贴数值跟格式可以用vba实现吗

再回首-沉默 · 发表于 2024-6-28 11:01

本帖最后由再回首-沉默于 2024-6-28 11:44 编辑

就是表二所有列有数据的都粘贴值跟格式到对应的表一【2个工作簿里面的工作表名字一致】，但是表一比表二多了几列数据，保留表一的公式数据，替换表二有的所有列，能用vba实现吗？

我把表1,2合并到表3。录制了宏，但是当表内没有个别表名，宏就运行不了

老师们，能搞个适用的vba吗

ykcbf1100 · 发表于 2024-6-28 13:27

难搞，表多倒没事，关键是标题行数不同。

再回首-沉默 · 发表于 2024-6-28 14:20

ykcbf1100 发表于 2024-6-28 13:27
难搞，表多倒没事，关键是标题行数不同。

老师，Range (“Ai”).CurrentRegion.Select 我试了用这个进行选择可以避免掉行列数的问题
就是选择工作表不知道怎么搞，按我那个方法，得把所有表名都打上去才行，而且不能填没有的表名，要不然就不能运行。
表名识别能有代码替代吗比如【柱】跟【柱（2）】，这2个的差距就差距在后面的【（2）】，所有表都是这样类似的表名

ykcbf1100 · 发表于 2024-6-28 14:59

再回首-沉默发表于 2024-6-28 14:20
老师，Range (“Ai”).CurrentRegion.Select 我试了用这个进行选择可以避免掉行列数的问题
就是选择工 ...

问题是你二个表合并不可能有二个标题吧？连标题行一起合并？

再回首-沉默 · 发表于 2024-6-28 15:25

ykcbf1100 发表于 2024-6-28 14:59
问题是你二个表合并不可能有二个标题吧？连标题行一起合并？

老师，有点不太清楚你说的标题行是指什么

我的思路是，把表1当前区域（指被空行和空列所包围的长方形区域）清空，把表2当前区域内容放到表1去。
这样应该没你说的2个标题吧，而且2个表的标题是一样的，这个不会不一样呢。

ykcbf1100 · 发表于 2024-6-28 15:29

再回首-沉默发表于 2024-6-28 15:25
老师，有点不太清楚你说的标题行是指什么

我的思路是，把表1当前区域（指被空行和空列所包围的长 ...

表太多，结构又不一样，难搞。

再回首-沉默 · 发表于 2024-6-28 15:40

ykcbf1100 发表于 2024-6-28 15:29
表太多，结构又不一样，难搞。

那行把，谢谢啦

feilanga · 发表于 2024-6-28 21:46

不要上来就发这么多表和数据.现在都搞不懂3个工作簿差别在哪里,谁复制谁,你要少量的模拟数据,尽可能的数据少一些,说明白需求和模拟完成后的效果,现在是看不懂你的需求到底是什么.

3190496160 · 发表于 2024-6-29 09:54

Sub 数据汇总()
Application.ScreenUpdating = False
Dim ww As Workbook, wb As Workbook
Dim d As Object
Set d = CreateObject("scripting.dictionary")
For Each sh In Sheets
sh.[a1].CurrentRegion.Offset.Borders.LineStyle = 0
sh.[a1].CurrentRegion.Offset(2).UnMerge
sh.[a1].CurrentRegion.Offset(2).ClearContents
d(sh.Name) = ""
Next sh
Set ww = ThisWorkbook
lj = ww.Path & "\"
f = Dir(lj & "*.xls*")
Do While f <> ""
If f <> ww.Name Then
      Set wb = Workbooks.Open(lj & f, 0)
      For Each sh In wb.Worksheets
         mc = sh.Name
         If d.exists(sh.Name) Then
            x = sh.Cells.Find("*", searchdirection:=xlPrevious).Row
            y = sh.Cells.Find("*", searchdirection:=xlPrevious).Column
            sh.Range(sh.Cells(3, 1), sh.Cells(x, y)).Copy
            With ww.Worksheets(sh.Name)
                  yy = .Cells(2, Columns.Count).End(xlToLeft).Column
                  lh = Replace(Cells(1, yy).Address(0, 0), 1, "")
                  ws = .Columns("a:" & lh).Find("*", searchdirection:=xlPrevious).Row + 1
                  .Cells(ws, 1).Resize(x - 2, y).PasteSpecial Paste:=xlPasteValues
                  .Cells(ws, 1).PasteSpecial Paste:=xlPasteFormats

            End With
         End If
      Next sh
      wb.Close False
End If
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "汇总完毕！", 64, "提醒"
End Sub

3190496160 · 发表于 2024-6-29 09:56

仅供参考

表3.rar (956.36 KB, 下载次数: 6)

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

[求助] 大佬们，跨工作簿进行数据的粘贴数值跟格式可以用vba实现吗