求一个判断工作簿存在的代码！

看脱了色彩

liulang0808 发表于 2020-1-30 21:29
按照楼主的思路，是每个部分都要按照这个要求写
3楼仅仅是针对一段代码

成了。4楼的朋友给了个提示。很巧妙，加一个条件就行了。
结果是这样的。

        '选择在“测试”中建立单价汇总表
        Dim w As Window
        For Each w In Application.Windows
            If InStr(w.Caption, "测试") Then w.Activate
        Next
        '定位A列最后一个有数据的单元格
        i = Cells(Rows.Count, 1).End(xlUp).Row
        Range(Cells(1, 1), Cells(i, 4)).Copy
        Sheets.Add
        Range("A1").Select
        ActiveSheet.Paste
        k = 0
        '复制单店数据到第一个工作簿新建的工作表
        For Each w In Application.Windows
            If InStr(w.Caption, "工作簿1") Then
                w.Activate
                k = 1
                Exit For
            End If
        Next
        If k = 1 Then
            '定位A列最后一个有数据的单元格
            i = Cells(Rows.Count, 1).End(xlUp).Row
            Range(Cells(1, 1), Cells(i, 4)).Copy
            For Each w In Application.Windows
                If InStr(w.Caption, "测试") Then w.Activate
            Next
            i = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Range("a" & i).Select
            ActiveSheet.Paste
            Range("A1").Select
            k = 0
        End If
        '复制单店数据 - 结束
        '复制单店数据到第一个工作簿新建的工作表
        For Each w In Application.Windows
            If InStr(w.Caption, "工作簿2") Then
                w.Activate
                k = 1
                Exit For
            End If
        Next
        If k = 1 Then
            '定位A列最后一个有数据的单元格
            i = Cells(Rows.Count, 1).End(xlUp).Row
            Range(Cells(1, 1), Cells(i, 4)).Copy
            For Each w In Application.Windows
                If InStr(w.Caption, "测试") Then w.Activate
            Next
            i = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Range("a" & i).Select
            ActiveSheet.Paste
            k = 0
        End If
        '复制单店数据 - 结束
        '复制单店数据到第一个工作簿新建的工作表
        For Each w In Application.Windows
            If InStr(w.Caption, "工作簿3") Then
                w.Activate
                k = 1
                Exit For
            End If
        Next
        If k = 1 Then
            '定位A列最后一个有数据的单元格
            i = Cells(Rows.Count, 1).End(xlUp).Row
            Range(Cells(1, 1), Cells(i, 4)).Copy
            For Each w In Application.Windows
                If InStr(w.Caption, "测试") Then w.Activate
            Next
            i = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Range("a" & i).Select
            ActiveSheet.Paste
            k = 0
        End If
        '复制单店数据 - 结束
        '复制单店数据到第一个工作簿新建的工作表
        For Each w In Application.Windows
            If InStr(w.Caption, "工作簿4") Then
                w.Activate
                k = 1
                Exit For
            End If
        Next
        If k = 1 Then
            '定位A列最后一个有数据的单元格
            i = Cells(Rows.Count, 1).End(xlUp).Row
            Range(Cells(1, 1), Cells(i, 4)).Copy
            For Each w In Application.Windows
                If InStr(w.Caption, "测试") Then w.Activate
            Next
            i = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Range("a" & i).Select
            ActiveSheet.Paste
            k = 0
        End If
        '复制单店数据 - 结束

excel海

怎么搞这么复杂,不如发文件重新写个

看脱了色彩

excel海 发表于 2020-1-30 22:07
怎么搞这么复杂,不如发文件重新写个

已经解决了。脑子里装的这些东西不多。只能用这些笨办法。
合并统计.rar (66.23 KB, 下载次数: 0)

2020-1-30 22:23 上传

点击文件名下载附件