请大神门出出手，在自动计算工作表，增加除自动计算，合并其它的所有工作表在一个....

刷卡机电脑监控

请大神门出出手，
1，在”自动计算“工作表，加多一个VBA。
2，除”自动计算“工作表，合并其它所有工作表的数据在一个新的工作表里。

timmessiah

试试，已经更新了代码

timmessiah

更新到按钮上了，点击就能用

Qs18

Sub hebing()
    Dim sht As Worksheet
    Sheets("自动计算").Range("a1:l10000") = ""
    For Each sht In Sheets
        If sht.Name <> "自动计算" Then
            If Sheets("自动计算").Range("a1") = "" Then
                sht.Range("a1:l1").Copy Sheets("自动计算").Range("a1")
            End If
            If sht.Range("a2") <> "" Then
                arr = sht.Range("a2:l" & sht.Cells(Rows.Count, 1).End(xlUp).Row)
                rw = Sheets("自动计算").Cells(Rows.Count, 1).End(xlUp).Row + 1
                Sheets("自动计算").Range("a" & rw).Resize(UBound(arr), UBound(arr, 2)) = arr
            End If
        End If
    Next
    MsgBox "合并完成！"
End Sub

Qs18

试试.............

Qs18

试一下..............

刷卡机电脑监控

Qs18 发表于 2024-6-19 18:06
Sub hebing()
    Dim sht As Worksheet
    Sheets("自动计算").Range("a1:l10000") = ""

你好，数据有点乱。不知道的数不对，可以修改一下代码吗，忽略第一行标题。

刷卡机电脑监控

Qs18 发表于 2024-6-19 18:09
试一下..............

F列有些显示是日期，修复了吗

Qs18

改一下格式就可以了

peteryhr

Sub byPeteryhr()
    Dim sht As Worksheet, i%, arr
    Sheet1.Cells.ClearContents
    For Each sht In ThisWorkbook.Sheets
        If sht.Name <> "自动计算" Then
            i = i + 1
            If i = 1 Then
                arr = sht.UsedRange
                Sheet1.Range("A1").Resize(UBound(arr), UBound(arr)) = arr
            Else
                arr = sht.UsedRange.Offset(1)
                Sheet1.Range("A" & Cells(Rows.Count, 1).End(xlUp).Row).Offset(1).Resize(UBound(arr), UBound(arr)) = arr
            End If
        End If
    Next
End Sub