Question

我是stackoverflow.com和VBA的新手。我一直在网上搜索VBA，它将允许我从输入的工作表1复制数据，然后根据单元格值匹配将其粘贴到工作表2。复制后，它将清除工作表1上的数据，而不会删除行。

我在呼叫中心工作，这将根据其所在的办公桌来更新设备。

因此，我希望将所有数据输入到工作表1的字段中后，我可以单击一个activex按钮，它将在工作表2的A列中搜索办公桌编号，然后更新该行（B：Q ）与工作表1中的数据。

我已经看到一些VBA可以复制数据，但它仅复制到下一个空单元格行。

这是我找到的代码，但是不正确。

Sub MoveRowBasedOnCellValue()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("A5:Q5" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = ("A5") Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

任何帮助都会很棒！谢谢。

Answer 1

类似于下面的代码？我假设办公桌编号在第2行的A列sheet1上。不过，您将需要调整两个表的末行。

Sub MoveRowBasedOnCellValue()
Dim s1 As Sheet1
Set s1 = Sheet1
Dim s2 As Sheet2
Set s2 = Sheet2
Dim s1StartRow As Integer
Dim s1EndRow As Integer
Dim s2StartRow As Integer
Dim s2EndRow As Integer
s1StartRow = 2
s1EndRow = 8
s2StartRow = 2
s2EndRow = 10


Application.ScreenUpdating = False
For i = s1StartRow To s1EndRow

 For j = s2StartRow To s2EndRow

   If s1.Cells(i, 1) = s2.Cells(j, 1) Then
    s1.Range("B" & i & ":Q" & i).Copy
    s2.Cells(j, 2).PasteSpecial xlPasteAll
   Application.CutCopyMode = False
   End If

  Next j

Next i
 Application.ScreenUpdating = True
End Sub

activeX按钮可根据单元格值将数据行从工作表1复制到工作表2

1 个答案: