[已解决]谁能帮我改下宏代码

1049671600

才接触VBA，很多东西还不懂，恳求大神帮助

最佳答案

月排行榜 / 总排行榜

zjdh

2019-5-13 22:38

Sub 复制()
    Dim rn%, rns As Range
    ar = Range("A3:J" & [J1].End(4).Row)
    With Sheets("sheet2")
        rn = .Cells(Rows.Count, 12).End(3).Row + 1
        If rn < 12 Then rn = 12
        .Range("L" & rn).Resize(UBound(ar), UBound(ar, 2)) = ar

        For Each rns In .Range("L12", .[L12].End(4))    '序号
            If rns <> "" Then  rns(1, 0) = rns.Row - 11
       Next
    End With
End Sub

跳转到最佳答案楼层

zjdh

Sub 复制()
    Dim rn%, rns As Range
    ar = Range("A3:J" & [J1].End(4).Row)
    With Sheets("sheet2")
        rn = .Cells(Rows.Count, 12).End(3).Row + 1
        If rn < 12 Then rn = 12
        .Range("L" & rn).Resize(UBound(ar), UBound(ar, 2)) = ar

        For Each rns In .Range("L12", .[L12].End(4))    '序号
            If rns <> "" Then  rns(1, 0) = rns.Row - 11
       Next
    End With
End Sub

zjdh

你的文件打不开，请重新上传附件。

1049671600

zjdh 发表于 2019-5-14 08:29
你的文件打不开，请重新上传附件。

感谢

hfwufanhf2006

range(Cells(2, 2), Cells(2, 11)).Copy Sheet2.Cells(Sheet2.[b1000].end(3).row + 1, 2)
Sheet2.Cells(Sheet2.[a1000].end(3).row + 1, 1) = Sheet2.Cells(Sheet2.[a1000].end(3).row, 1) + 1
range(Cells(2, 2), Cells(2, 11)).Copy Sheet2.Cells(Sheet2.[l1000].end(3).row + 1, 12)

第一行是把sheet1的b2:k2区域数据复制到sheet2的b:k列的对应位置，原有的数据不变，复制的数据依次往后排。你模拟表sheet1的数据是a2:n2，这个宽度在sheet2中排不下，所以我截取了对应的宽度；
第二行就是在sheet2的a列顺序编号；
第三行代码是把sheet1的b2:k2区域数据复制到sheet2的K:U列，原有数据不变，复制的数据依次往下排