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

10520

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复制到新建的一个工作表上面

10520

附件+图片

10520

图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

网海遨游

是不是这个意思呢?
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

taller

你不需要新工作表的话，就不需要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
   
9. 
   

复制代码

10520

taller 发表于 2020-3-19 01:54
你不需要新工作表的话，就不需要Add

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

taller

代码只是示例，实现你的这个要求

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

10520

网海遨游 发表于 2020-3-18 16:16
是不是这个意思呢?
Sub Test()
Dim sht, r, arr, brr(1 To 5, 1 To 1),sth

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


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

10520

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个。

taller

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

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
   

复制代码