如何移动一个工作薄内其它表内数据到一张表内

老KD

各位老师好！请教，请帮忙写个VBA实现移动一个工作薄内其它表内数据到一张表内，祥见附件，谢谢谢谢！！！

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    For j = 2 To Sheets.Count
        Z = Sheets(1).UsedRange.Rows.Count
        Sheets(j).UsedRange.Copy Sheets(1).Cells(Z + 1, 1)
        Sheets(j).UsedRange.Clear
    Next j
    Application.ScreenUpdating = True
End Sub

liulang0808

附件内容供参考。。。。。。

网海遨游

Sub test()
   Dim sht
  Application.DisplayAlerts = False '禁止弹出警告
  Application.ScreenUpdating = False '禁止屏幕刷新
   For Each sht In Sheets
      If sht.Name <> "王村" Then
        r = UBound(Sheets("王村").UsedRange.Value) + 1
        If sht.[a2] = "" Then
        sht.UsedRange.Copy Sheets("王村").Cells(r, 1)
        sht.UsedRange = ""
        Else
         sht.UsedRange.Offset(1).Copy Sheets("王村").Cells(r, 1)
         sht.UsedRange = ""
        End If
      End If
   Next
   MsgBox "恭喜你！操作成功！", 64, "温馨提示……"
  Application.DisplayAlerts = True '允许警告
  Application.ScreenUpdating = True '允许刷新
End Sub

网海遨游

代码在审核,这是附件,点击按钮后,就能看到数据合并了.

老KD

liulang0808 发表于 2020-3-8 09:38
附件内容供参考。。。。。。

谢谢老师！！我把原表发您帮忙看下，运行宏时显示定义错，请帮忙再调整下你的代码，谢谢谢谢！！

liulang0808

老KD 发表于 2020-3-8 10:01
谢谢老师！！我把原表发您帮忙看下，运行宏时显示定义错，请帮忙再调整下你的代码，谢谢谢谢！！

代码运行正常，没有报错，楼主再检查下吧

老KD

liulang0808 发表于 2020-3-8 10:10
代码运行正常，没有报错，楼主再检查下吧

老师好，不好意思，是我没说清楚，是您这个代码运行我这个名单（后来上传的原表，请下载）时报错1004，提示要在以下红色字处调试，麻烦您再看看原表名单运行下，十分感谢
Sub 按钮1_Click()
    Application.ScreenUpdating = False
    For j = 2 To Sheets.Count
        Z = Sheets(1).UsedRange.Rows.Count
        Sheets(j).UsedRange.Copy Sheets(1).Cells(Z + 1, 1)
        Sheets(j).UsedRange.Clear
    Next j
    Application.ScreenUpdating = True
End Sub

liulang0808

老KD 发表于 2020-3-8 10:24
老师好，不好意思，是我没说清楚，是您这个代码运行我这个名单（后来上传的原表，请下载）时报错1004，提 ...

楼主刚上传的附件，未见代码
使用刚才的附件而是未见异常
楼主规范下表格内容，然后再看看
如果还有问题，带着代码一起上传吧

老KD

liulang0808 发表于 2020-3-8 10:27
楼主刚上传的附件，未见代码
使用刚才的附件而是未见异常
楼主规范下表格内容，然后再看看

麻烦老师再次看看！！非常谢谢，不好意思，菜鸟在此致敬！！