急求！合并sheet数据！

EdsionZL · 发表于 2018-5-8 14:01

本帖最后由 EdsionZL 于 2018-5-8 14:08 编辑

将多个sheet数据按照标签合并到指定sheet中

EdsionZL · 发表于 2018-5-8 14:08

求各位大神帮忙看看！

EdsionZL · 发表于 2018-5-9 09:55

求助各位大神有空看看！谢谢了！

lv_king_2017 · 发表于 2018-5-9 14:55

Sub FillByHeader()
Application.ScreenUpdating = False
Dim sht1 As Worksheet, sht As Worksheet
Dim lRow As Long, lCol As Long, lRow1 As Long, lCol1 As Long
Dim cell1 As Range, cell2 As Range

Set sht1 = ActiveWorkbook.Sheets("最终结果")

For Each sht In ActiveWorkbook.Sheets
      If sht.Name <> sht1.Name Then
         For Each cell1 In sht.Range("A1:E1")
            For Each cell2 In sht1.Range("A1:E1")
                  If cell1.Value = cell2.Value Then
                     lCol = cell1.Column
                     lRow = sht.Columns(lCol).Cells(Rows.Count, 1).End(xlUp).Row

                     lCol1 = cell2.Column
                     lRow1 = sht1.Columns(lCol1).Cells(Rows.Count, 1).End(xlUp).Row

                     If lRow > 1 Then
                        sht.Activate
                        sht.Range(Cells(2, lCol), Cells(lRow, lCol)).Copy sht1.Cells(lRow1 + 1, lCol1)
                     End If
                  End If
            Next cell2
         Next cell1
      End If
Next sht

End Sub

EdsionZL · 发表于 2018-5-9 16:09

lv_king_2017 发表于 2018-5-9 14:55
Sub FillByHeader()
Application.ScreenUpdating = False
Dim sht1 As Worksheet, sht As Worksh ...

大神，我运行这段代码，但是没有任何结果，我逐段运行也没发现任何问题，能否再帮忙看看，谢谢

lv_king_2017 · 发表于 2018-5-9 16:22

结果就在最终结果工作表，只是覆盖了而已
你把改该表中A1到E1意外的单元格清空，运行就看到了，结果就在该表里

EdsionZL · 发表于 2018-5-9 17:22

lv_king_2017 发表于 2018-5-9 16:22
结果就在最终结果工作表，只是覆盖了而已
你把改该表中A1到E1意外的单元格清空，运行就看到了，结果就在 ...

我清空了数据还是不可以，是不是版本不同，我是10版本的Excel

lv_king_2017 · 发表于 2018-5-9 17:27

我是2013版本的，2010也能用的，没用什么特殊的东西。就用你上传的附件运行正常。你用的工作表是和附件的一样吗，工作表名称没改吧。

lv_king_2017 · 发表于 2018-5-9 17:28

你运行的工作表截个图看看

EdsionZL · 发表于 2018-5-11 09:42

lv_king_2017 发表于 2018-5-9 17:28
你运行的工作表截个图看看

工作表就是原表也不行，能够运行，但是没有结果，提示数据为空

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