ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

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

[求助] 工作表数据依次复制点到工作表1-工作表2......工作表100

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-3-18 14:58 | 显示全部楼层 |阅读模式
1.工作表1:A1:E1复制到工作表-1:F1:F5
1.工作表1:A2:E2复制到工作表-2:F1:F5

自己写了一个代码:
Sub i()
Dim i
i = Cells(2, Columns.Count).End(xlToLeft).Column
For ii = 6 To i
With Worksheets.Add
.Move After:=Sheets(Sheets.Count)
Sheets(1).Columns("a:e").Copy .[a1]
Sheets(1).Columns(ii).Copy .[f1]
End With
Next
End Sub

但是他会插入到新的工作表,不会按照我刚才说的A1:E1复制到工作表-1:F1:F5,而是A1:E1复制到新建的一个工作表上面

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-18 15:00 | 显示全部楼层
附件+图片
1.jpg
2.jpg
3.jpg

殷雷预结算1.zip

22.05 KB, 下载次数: 4

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-18 15:25 | 显示全部楼层

工作表数据依次复制点到工作表1-工作表2......工作表100

图1和2就是原始格式和需要的效果格式1.工作表1:A1:E1复制到工作表-1:F1:F5
2.工作表1:A2:E2复制到工作表-2:F1:F5
.
.
.
100.工作表1:A100:E100复制到工作表-100:F1:F5

图3:是自己写的一个代码 但是代码有问题,他会插入到新的工作表,不会按照我刚才说的A1:E1复制到工作表-1:F1:F5,而是A1:E1复制到新建的一个工作表上面

代码是:

Sub i()
Dim i
i = Cells(2, Columns.Count).End(xlToLeft).Column
For ii = 6 To i
With Worksheets.Add
.Move After:=Sheets(Sheets.Count)
Sheets(1).Columns("a:e").Copy .[a1]
Sheets(1).Columns(ii).Copy .[f1]
End With
Next
End Sub
3.jpg
2.jpg
1.jpg

殷雷预结算1.zip

22.05 KB, 下载次数: 13

TA的精华主题

TA的得分主题

发表于 2020-3-18 16:16 | 显示全部楼层
是不是这个意思呢?
Sub Test()
Dim sht, r, arr, brr(1 To 5, 1 To 1),sth
   Set sht = Sheets("工程量清单")
   r = sht.Cells(Rows.Count, 1).End(3).Row
   arr = sht.Range("a1:e" & r)
   For i = 1 To UBound(arr)
      On Error Resume Next
      Set sth = Sheets(arr(i, 1))
      If Err <> 0 Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = arr(i, 1)
      Set sth = Sheets(arr(i, 1))
      For j = 1 To 5
      brr(j, 1) = arr(i, j)
      Next j
      sth.[f1].Resize(5) = ""
      sth.[f1].Resize(5) = brr
   Next i
End Sub

TA的精华主题

TA的得分主题

发表于 2020-3-19 01:54 | 显示全部楼层
本帖最后由 taller 于 2020-3-19 11:20 编辑

你不需要新工作表的话,就不需要Add

  1. Sub demo()
  2.     With Sheets(1)
  3.         '1.工作表1:A1:E1复制到工作表-1:F1:F5
  4.         Sheets("-1").Range("F1:F5").Value = Application.Transpose(.Range("A1:E1").Value)
  5.         '1.工作表1:A2:E2复制到工作表-2:F1:F5
  6.         Sheets("-2").Range("F1:F5").Value = Application.Transpose(.Range("A2:E2").Value)
  7.     End With
  8. End Sub

复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-19 10:50 | 显示全部楼层
taller 发表于 2020-3-19 01:54
你不需要新工作表的话,就不需要Add

这个代码运行后第二行到第一个工作表了。然后他不循环继续。第二个工作表没有数据呢
1.jpg

TA的精华主题

TA的得分主题

发表于 2020-3-19 10:54 | 显示全部楼层
代码只是示例,实现你的这个要求

1.工作表1:A1:E1复制到工作表-1:F1:F5
1.工作表1:A2:E2复制到工作表-2:F1:F5

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-19 10:54 | 显示全部楼层
网海遨游 发表于 2020-3-18 16:16
是不是这个意思呢?
Sub Test()
Dim sht, r, arr, brr(1 To 5, 1 To 1),sth

灰常感谢,今天看到测试一下,可以使用,我还要一个疑问


代码是通过A列数值和每个工作表名称对应来实现把总工作表的数据依次复制到每个工作表的吗。
我当初是手动复制的A列,但是实际情况可能A列数据是和每个工作表名称不一致的,那样的话代码能实现吗。
2.jpg

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-19 10:57 | 显示全部楼层
taller 发表于 2020-3-19 10:54
代码只是示例,实现你的这个要求

1.工作表1:A1:E1复制到工作表-1:F1:F5

哦哦,没表达清楚问题,我需要的是
1.工作表1:A1:E1复制到工作表-1:F1:F5
2.工作表1:A2:E2复制到工作表-2:F1:F5
.
.
.
100.工作表1:A100:E100复制到工作表-100:F1:F5

表格不确定多少个但是很多,比如工作表有2000行,那么后面的工作表也有2000个。

TA的精华主题

TA的得分主题

发表于 2020-3-19 11:32 | 显示全部楼层
本帖最后由 taller 于 2020-3-19 13:03 编辑

如果你的后面的工作表都已经存在

  1. Sub demo()
  2.     For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
  3.         Sheets(CStr(-1 * i)).Range("F1:F5").Value = Application.Transpose(Sheets(1).Range("A1:E1").Offset(i - 1, 0).Value)
  4.     Next
  5. End Sub
复制代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

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

GMT+8, 2020-7-5 15:26 , Processed in 0.070755 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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