[已解决]把工作表2各表中数据复制到工作表3各对应表中

ymq123 · 发表于 2014-12-24 17:55

1、编写代码
2、把工作表2中数据每隔6行在一起复制，放到工作表3内。复制在一起的行用相同背景色标识，
4、工作表4是复制结果。

最佳答案

爱疯

2014-12-24 21:28

Sub test()
Dim A, B, i, j, k, s, n
A = Sheets(2).[A1:AF35]
ReDim B(1 To UBound(A), 1 To UBound(A, 2))
n = 7
For k = 1 To n
      For i = k To UBound(A) Step n
         s = s + 1
         For j = 1 To UBound(A, 2)
            B(s, j) = A(i, j)
         Next j
      Next i
Next k
Sheets(3).UsedRange = ""
Sheets(3).[a1].Resize(UBound(B), UBound(B, 2)) = B
End Sub

把工作表2各表中数据复制到工作表3各对应表中.rar (26.65 KB, 下载次数: 10)

爱疯 · 发表于 2014-12-24 19:31

Sub test()
Dim r, i, n

n = 6
r = Sheets(2).UsedRange.Rows.Count
Sheets(3).Activate
Cells.Clear
Sheets(2).UsedRange.Copy Range("a1")

For i = 1 To r Step n
Range(Cells(i, 1), Cells(i + n - 1, "af")).Interior.Color = _
RGB(Rnd * 256, Rnd * 256, Rnd * 256)
Next i
Rows(r + 1 & ":65536").Clear
End Sub

把工作表2各表中数据复制到工作表3各对应表中2.rar (39.87 KB, 下载次数: 4)

ymq123 · 发表于 2014-12-24 19:53

爱疯发表于 2014-12-24 19:31
Sub test()
Dim r, i, n

把工作表2中数据每隔6行在一起复制，放到工作表3内,复制结果如工作表4（背景颜色应是无色），不是设置背景色。你这里是把工作表2直接复制到工作表3，不是我要的。请修改。

爱疯 · 发表于 2014-12-24 21:28

Sub test()
Dim A, B, i, j, k, s, n
A = Sheets(2).[A1:AF35]
ReDim B(1 To UBound(A), 1 To UBound(A, 2))
n = 7
For k = 1 To n
      For i = k To UBound(A) Step n
         s = s + 1
         For j = 1 To UBound(A, 2)
            B(s, j) = A(i, j)
         Next j
      Next i
Next k
Sheets(3).UsedRange = ""
Sheets(3).[a1].Resize(UBound(B), UBound(B, 2)) = B
End Sub

把工作表2各表中数据复制到工作表3各对应表中.rar (26.65 KB, 下载次数: 10)

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