如何将多工作簿中指定工作表合并为同一工作表且保留一个表头

小灰灰520

我想把多个工作簿中的指定名称的工作表（这些工作表出于同一模板只是填写内容不同而已）合并为一个工作表，并且保留一次表头部分，请教大神该怎么处理？

这里指定的工作表名称是“科室考勤”，表头部分是第3-4行。
考勤.zip (496.51 KB, 下载次数: 13)

2023-2-27 23:49 上传

点击文件名下载附件

mmwwdd

这种合并论坛里例子非常多，随便搜索一下

shiruiqiang

因为你表格里面填充了太多公式，如星期啥的，只能前面四栏复制过来。取巧一下，最后筛选一下吧。医疗机构的随手写一下吧

shiruiqiang

代码有点错误，修正了

liulang0808

Sub 按钮4_Click()
    Set fso = CreateObject("scripting.filesystemobject")
    x = 0
    Application.ScreenUpdating = False
    w = 5
    For Each f In fso.getfolder(ThisWorkbook.Path).Files
        If InStr(f.Name, ThisWorkbook.Name) = 0 Then
            With Workbooks.Open(f)
                x = x + 1
                If x = 1 Then
                    .Sheets("科室考勤").Copy after:=ThisWorkbook.Sheets(1)
                    Set sh = ThisWorkbook.Sheets(2)
                Else
                    For j = w To sh.Cells(Rows.Count, 2).End(3).Row
                        If Len(sh.Cells(j, 2)) = 0 Then
                            w = j
                            Exit For
                        End If
                    Next j
                    .Sheets("科室考勤").UsedRange.Offset(4).Copy sh.Cells(w, 1)
                End If
                .Close False
            End With
        End If
    Next f
    Application.ScreenUpdating = True
End Sub

liulang0808

供参考。。。。。。。。

小灰灰520

shiruiqiang 发表于 2023-2-28 07:57
代码有点错误，修正了

完美解决！
大神，我还有一些小问题想请教，如果我只想把第3-4行设置为表头，不要第1-2行，可以修改代码里的哪些变量实现吗？
另外，我原始表里的周末是绿色标注，合并后变成了桔色，并且列宽变了，如果想保持原表的格式设置合并过来麻烦吗？

小灰灰520

liulang0808 发表于 2023-2-28 08:02
Sub 按钮4_Click()
    Set fso = CreateObject("scripting.filesystemobject")
    x = 0

大神，原工作簿合并后完全没有问题，但是如果我先把原来的4个工作簿公式转值或者是删除表格下方的空格后再合并就只能合并部门4里的内容，请问这是为什么啊？

liulang0808

小灰灰520 发表于 2023-2-28 10:40
大神，原工作簿合并后完全没有问题，但是如果我先把原来的4个工作簿公式转值或者是删除表格下方的空格后 ...

上附件说明吧

小灰灰520

liulang0808 发表于 2023-2-28 11:05
上附件说明吧

新建文件夹.zip (220.34 KB, 下载次数: 5)

2023-2-28 11:15 上传

点击文件名下载附件