excel 将数据从组表粘贴到新工作表中

bis0qfac  于 2023-11-20  发布在  其他
关注(0)|答案(1)|浏览(122)

我需要一个新的汇总表,一旦提交按钮被点击。


的数据
我试图复制第一行,不知道如何去新的列所需的。新的数据应粘贴到空列。
下面的代码适用于行。

Sub data_input2()
    
    ws_output = "Sheet3"
    
    next_row = Sheets(ws_output).Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    
    Sheets(ws_output).Cells(next_row, 1).Value = Range("B1").Value
    Sheets(ws_output).Cells(next_row, 2).Value = Range("B2").Value
    Sheets(ws_output).Cells(next_row, 3).Value = Range("B3").Value
    Sheets(ws_output).Cells(next_row, 4).Value = Range("A8").Value
    Sheets(ws_output).Cells(next_row, 5).Value = Range("B8").Value
    Sheets(ws_output).Cells(next_row, 6).Value = Range("C5").Value
    Sheets(ws_output).Cells(next_row, 7).Value = Range("C6").Value
    Sheets(ws_output).Cells(next_row, 8).Value = Range("C7").Value
    Sheets(ws_output).Cells(next_row, 9).Value = Range("C8").Value
    
End Sub

字符串
点击提交后,它应该看起来像这样。


70gysomp

70gysomp1#

根据需要进行调整…

Sub Tester()

    Dim ws As Worksheet, c As Range, cOut As Range
    
    Set ws = Worksheets("Input")  'has your original table
    
    Set cOut = Worksheets("Output").Range("A2") 'start of reformatted data
    'start at next empty row on sheet
    'Set cOut = Worksheets("Output").Cells(Rows.Count, "A").End(xlUp).Offset(1)

    'loop through the data values
    For Each c In ws.Range("C8:J11").Cells
        cOut.Resize(1, 9).Value = Array(ws.Range("B1").Value, ws.Range("B2").Value, _
                        ws.Range("B3").Value, MergeValue(c.EntireRow.Cells(1)), _
                        c.EntireRow.Cells(2).Value, MergeValue(c.EntireColumn.Cells(5)), _
                        MergeValue(c.EntireColumn.Cells(6)), _
                        MergeValue(c.EntireColumn.Cells(7)), c.Value)
        Set cOut = cOut.Offset(1) 'next row down
    Next c
    
    
End Sub

'return the value from a (maybe merged) cell
Function MergeValue(c As Range)
    MergeValue = c.MergeArea(1).Value
End Function

字符串

相关问题