高难度的“异表复制问题”

qhllqhll · 发表于 2011-3-17 17:06

老师您好：在您不忙的时候麻烦您再给帮忙写一下代码吧
谢谢

[ 本帖最后由 qhllqhll 于 2011-3-17 17:15 编辑 ]

dsmch · 发表于 2011-3-17 17:16

你附件中工作薄2数据空白，不清楚数据格式，无法写代码。

qhllqhll · 发表于 2011-3-17 17:29

谢谢了我再看看

qhllqhll · 发表于 2011-3-17 18:12

老师您好：我的工作薄里启用了宏表不过已经隐藏了现在复制来的内容要粘贴的表次是第三个请问：在代码“ Set ws = ThisWorkbook.Sheets(2) ”应填写几啊？现在老师提示复制的格式与....不符，老师您看应怎么处理啊
谢谢

zcq326 · 发表于 2011-3-17 21:46

高手真多啊，学习了！

dsmch · 发表于 2011-3-18 05:27

原帖由 qhllqhll 于 2011-3-17 18:12 发表
老师您好：我的工作薄里启用了宏表不过已经隐藏了现在复制来的内容要粘贴的表次是第三个请问：在代码“ Set ws = ThisWorkbook.Sheets(2) ”应填写几啊？现在老师提示复制的格式与....不符，老师您看应怎么 ...

Set ws = ThisWorkbook.Sheets(3)

qhllqhll · 发表于 2011-3-18 06:20

Set ws = ThisWorkbook.Sheets(3)
老师这里的（3）能否用工作薄里的工作表名代替啊谢谢
例如：（采集表3）或（其他名）啊
我认为那样会更准确一些啊？
代码应该怎么改啊

[ 本帖最后由 qhllqhll 于 2011-3-18 06:22 编辑 ]

qhllqhll · 发表于 2011-3-18 07:15

老师您好在您空闲的时候帮我把您的代码整理到我想要的代码2里谢谢
1、一下是您帮我写的代码（在普通表里您的这段代码运行很好，实际到了我的表里就提示：无法识别的格式我没办法了，只好再请您帮助）
On Error Resume Next
Dim ws As Worksheet, arr, wj As String
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets(2)
ws.Cells.ClearContents
wj = Dir(ThisWorkbook.Path & "\")
x = Val(InputBox("输入行号，行号大于等于4："))
If x < 4 Then Exit Sub
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & wj
Sheets(1).Activate
arr = Range(Cells(x, 1), Cells(x + 99, "o"))
ws.Range("a4").Resize(UBound(arr), UBound(arr, 2)) = arr
Workbooks(wj).Close
Application.ScreenUpdating = True
2、再下面就是我想要的代码了
这个意思是：从“原表”的第一个表里复制选（再加上原来我和您要求的那些：也就是：加上弹出的要输入行号的代码和不得小于4，每次之选100行和每次运行钱要清空(a4:o100)的代码），以数值方式粘贴在(我要的表.xls").里，这个名字可以不要改变。
Sub 异表复制()
Windows("原表.xls").Activate             '这个("要复制的原表.xls")名字请改成通用名  ("*.xls")
Range("A4:103").Select                            ' 请把这里加上弹出要输入行号的对话框同时加上if x <4就推出
Application.CutCopyMode = False
Selection.Copy

'一下可以不改动
Windows("我要的表.xls").Activate       ' 这个("我要的表.xls").名字可以不用改名
ActiveWorkbook.RunAutoMacros Which:=xlAutoActivate
Range("A4").Select                                  '以数值的方式粘贴在本表的 a4 里
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False                      '以数值的方式粘贴
Range("C4").Select
End Sub
辛苦老师您了！再次感谢

[ 本帖最后由 qhllqhll 于 2011-3-18 07:52 编辑 ]

dsmch · 发表于 2011-3-18 08:04

原帖由 qhllqhll 于 2011-3-18 06:20 发表
Set ws = ThisWorkbook.Sheets(3)
老师这里的（3）能否用工作薄里的工作表名代替啊谢谢
例如：（采集表3）或（其他名）啊
我认为那样会更准确一些啊？
代码应该怎么改啊

sheets("工作表名")
代码自己改吧，具体附件，具体对待。

qhllqhll · 发表于 2011-3-18 08:57

谢谢老师您的帮助

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

[求助] 高难度的“异表复制问题”

回复 15楼 dsmch 的帖子

回复 17楼 dsmch 的帖子

回复 12楼 dsmch 的帖子

回复 21楼 dsmch 的帖子

回复 22楼 qhllqhll 的帖子

回复 24楼 dsmch 的帖子