Question

我对VBA有点新意，所以我有一个问题。我有2张excel。首先有一个表格，用于表格的形式＆＃34;供用户输入数据。我需要一种方法将第一张纸中的随机单元格复制到第二张纸上的（第一个空）单行，并为每个新条目执行此操作。

例如，我需要将数据从sheet1，单元格：J4，B5，J5，K6，D8，E11复制到sheet2，单元格：A2，B2，C2，D2，E2，F2。在sheet1的下一个条目中，我需要将数据放在sheet2上，单元格为：A3，B3，C3，D3，E3，F3，下一个是A4，B4，C4，D4，E4，F4等等。

提前感谢任何可以提供帮助的人和所有人。

Answer 1

不是一个非常优雅的解决方案，但它的工作原理。如果在工作表2上没有标题行，请在iRow

之后删除+1

Sub CopyCells()

Dim iRow As Integer

'Get last row on sheet 2
iRow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

'copy each cell on sheet 2
Sheets("Sheet2").Cells(iRow + 1, 1) = Sheets("Sheet1").Range("J4")
Sheets("Sheet2").Cells(iRow + 1, 2) = Sheets("Sheet1").Range("B5")
Sheets("Sheet2").Cells(iRow + 1, 3) = Sheets("Sheet1").Range("J5")
Sheets("Sheet2").Cells(iRow + 1, 4) = Sheets("Sheet1").Range("K6")
Sheets("Sheet2").Cells(iRow + 1, 5) = Sheets("Sheet1").Range("D8")
Sheets("Sheet2").Cells(iRow + 1, 6) = Sheets("Sheet1").Range("E11")

End Sub

Answer 2

如果您想在将数据输入到sheet1时将数据输入到另一个工作表中，那么我建议您查看使用worksheet_change事件。

这是我放在一起的一个简单例子：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim KeyCells As Range
    Dim Sheet2 As Worksheet
    Dim lastColumn As Long
    Dim lastRow As Long

    Set KeyCells = Range("A1:C5")
    Set Sheet2 = ActiveWorkbook.Sheets("Sheet2")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

        lastRow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row

        ' Start on second row
        If lastRow = 1 Then lastRow = 2

        lastColumn = Sheet2.Cells(lastRow, Columns.Count).End(xlToLeft).Column

        ' Move to next row after the 5th column
        If lastColumn > 5 Then
            lastRow = lastRow + 1
            lastColumn = 1
        End If

        Sheet2.Cells(lastRow, lastColumn + 1).Value = Target.Value

    End If

End Sub

此函数将写入在Sheet1到Sheet 2上的单元格A1到C5中输入的任何值。这些值将从第2行开始写入，在第5列之后，新值将自动写入下一行。

您需要根据具体情况调整此示例，但希望它可以帮助您开始朝着正确的方向发展。

如果您想要等到所有数据首先输入到sheet1，您可以轻松添加一个触发类似宏的按钮，将数据动态复制到正确的行/列，如上所述。

希望有所帮助！

Answer 3

    'It seems, you want to linearize your range.
    'Use following code to achieve that.
    'Plz customize as per your exact needs
    Sub LinearizeMyRange()
        'find last row in sheet2
        Sheet2.Activate
        sheet2lastrow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
        'Linearize range to next row
        n = 1
        For Each c In Sheet1.Range("A1:C5")
        Sheet2.Cells(sheet2lastrow + 1, n) = c
        n = n + 1
        Next c
    End Sub

将随机多个excel单元格复制到一行中

3 个答案: