ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 900|回复: 6

[求助] 为什么我的代码只用了一天就用不了了?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2014-4-14 08:47 | 显示全部楼层 |阅读模式
本帖最后由 天地有雪 于 2014-4-14 08:47 编辑

求各位大神帮忙看看,这是我昨天自己录制&修改的宏,本来昨天是用得好好的,可是今天突然就用不了了!也没有发现问题在哪里?
我的原意是要把工作簿111中各个分表复制到相对应的工作簿。
请大神们帮忙看看!非常感谢!



该贴已经同步到 天地有雪的微博

新建文件夹.zip

149.85 KB, 下载次数: 15

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-4-14 09:19 | 显示全部楼层
我忘了把代码附上了!
Sub tet()
    Dim sht As Worksheet, i As Integer, n As Integer
    i = 1
    n = Application.WorksheetFunction.CountA(Worksheets("发送").Range("A:A"))
    For Each sht In Worksheets
        Select Case i
            Case Is = 1                                                                                                     '第一个Sheet是汇总表,不需要复制
                i = i + 1
            Case 2 To n                                                                                                     '2到n个sheet是要处理的表
                ThisWorkbook.Activate
                Application.DisplayAlerts = False                                                                           '取消显示警告对话框
                Sheets(sht.Name).Select
                Columns("a:dm").Select
                Selection.Copy
                Workbooks.Open Filename:=Dir(ThisWorkbook.Path & "\" & Worksheets("发送").Cells(i, 1) & ".xlsx")            '打开工作簿
                Workbooks("CHR-" & sht.Name).Activate                                                                       '激活工作簿
                Sheets(sht.Name).Range("A1").Select
                Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone                                              '选择性粘贴--数值
                Application.CutCopyMode = False                                                                             '取消剪切复制模式
                ActiveWorkbook.Close savechanges:=True                                                                      '保存并关闭
                i = i + 1
            Case Else
                Exit For                                                                                                    '结束For Each语句,防止sht超_
        End Select                                                                                                          '标弹出阻止框
    Next sht
End Sub

代码有点乱!!新手!

TA的精华主题

TA的得分主题

发表于 2014-4-14 09:46 | 显示全部楼层
      Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Worksheets("发送").Cells(i, 1) & ".xlsx"           '打开工作簿
                Workbooks("CHR-" & sht.Name & ".xlsx").Activate  

评分

参与人数 1鲜花 +2 收起 理由
天地有雪 + 2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2014-4-14 10:30 | 显示全部楼层
Sub zz()
    Dim sc, c
    Application.DisplayAlerts = False
    sc = Array("TS1", "TS2", "TS3")
    For Each c In sc
        Sheets(c).Activate
        Columns("a:dm").Copy
        Workbooks.Open (ThisWorkbook.Path & "\" & "CHR-" & c & ".xlsx")
        With ActiveWorkbook
            .Sheets(c).Range("A1").Select
            Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone
            Application.CutCopyMode = False
            .Close True
        End With
    Next
    Application.DisplayAlerts = True
End Sub

评分

参与人数 1鲜花 +2 收起 理由
天地有雪 + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-4-14 11:52 | 显示全部楼层
KCFONG 发表于 2014-4-14 09:46
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Worksheets("发送").Cells(i, 1) & ".xlsx"    ...

可以了!感谢版主!
我想问一下,Workbooks.Open 是不是不可以跟 dir()一起使用啊??

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-4-14 11:57 | 显示全部楼层
zax010 发表于 2014-4-14 10:30
Sub zz()
    Dim sc, c
    Application.DisplayAlerts = False

高人啊!!简短又易懂!!
我想问问,如果我要把工作簿111的表"TS1","TS2"复制到工作簿"TS1"中的表"TS1","TS2";把工作簿111的表"TS2","TS3"复制到工作簿"TS3"中的表"TS2","TS3";那代码应该怎么改啊?
意思就是说,一表复制一表,变成多表复制多表!

TA的精华主题

TA的得分主题

发表于 2014-4-15 09:36 | 显示全部楼层
天地有雪 发表于 2014-4-14 11:57
高人啊!!简短又易懂!!
我想问问,如果我要把工作簿111的表"TS1","TS2"复制到工作簿"TS1"中的表"TS1" ...

谢谢你和你的鲜花。
先在对应的工作簿添加要复制的工作表(TS2),再运行以下代码:

Sub zzz()
    Dim sc, c, q, wk As Workbook
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    sc = Array("TS1", "TS2", "TS3")
    For Each c In sc
        Set wk = Workbooks.Open(ThisWorkbook.Path & "\" & "CHR-" & c & ".xlsx")
        For Each q In sc
            ThisWorkbook.Sheets(q).Activate
            Columns("a:dm").Copy
            With wk
                .Sheets(q).Range("A1").PasteSpecial Paste:=xlPasteValues, operation:=xlNone
                Application.CutCopyMode = False
            End With
        Next
        wk.Close True
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

评分

参与人数 1鲜花 +2 收起 理由
天地有雪 + 2 太强大了!这就是我想要的!非常感谢啊!!

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-10-17 23:47 , Processed in 0.064928 second(s), 21 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表