кнопка activeX для копирования строки данных из листа 1 в лист 2 на основе значения ячейки

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

Что-то вроде кода ниже?Я предположил, что номер стола находится в столбце A sheet1, начиная со строки 2. Хотя вам нужно будет отрегулировать конечные строки для обоих листов.

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