[已解决]档案转换

lkk0063

需求:
按下 Add to Out 按钮,自动将"In"内容输入到"Out"中

最佳答案

月排行榜 / 总排行榜

zjdh

2022-9-5 18:21

数据不多，用复制黏贴就可以啦。
Private Sub CommandButton2_Click()
    Set WK = Workbooks.Open(ThisWorkbook.Path & "\Out.Xlsm")
    With WK.Sheets("BB")
        W = .[A65536].End(3).Row
        If W < 6 Then W = 6
        .Cells(W, 1) = Split([G1], "-")(0)
        .Cells(W, 2) = Year([C1])
        .Cells(W, 3) = [C1]
        .Cells(W, 4) = [E1]
        For i = 3 To 17
            Set C = .Cells.Find(Cells(i, "A").Value, lookat:=xlWhole)
            CL = C.Column
            Range(Cells(i, "F"), Cells(i, "J")).Copy .Cells(W, CL)
        Next
    End With
    WK.Close True
End Sub

跳转到最佳答案楼层

zjdh

你确定“OUT”文件中“1、2、3、....”是这样的吗？“4、5”又放在哪列？

lkk0063

zjdh 发表于 2022-9-5 15:52
你确定“OUT”文件中“1、2、3、....”是这样的吗？“4、5”又放在哪列？

你好
这个应该是要照编号 1~5 放入，只是我忘记改了

zjdh

数据不多，用复制黏贴就可以啦。
Private Sub CommandButton2_Click()
    Set WK = Workbooks.Open(ThisWorkbook.Path & "\Out.Xlsm")
    With WK.Sheets("BB")
        W = .[A65536].End(3).Row
        If W < 6 Then W = 6
        .Cells(W, 1) = Split([G1], "-")(0)
        .Cells(W, 2) = Year([C1])
        .Cells(W, 3) = [C1]
        .Cells(W, 4) = [E1]
        For i = 3 To 17
            Set C = .Cells.Find(Cells(i, "A").Value, lookat:=xlWhole)
            CL = C.Column
            Range(Cells(i, "F"), Cells(i, "J")).Copy .Cells(W, CL)
        Next
    End With
    WK.Close True
End Sub