时间戳

首页 > 解决方案 > activeX 按钮可根据单元格值将工作表 1 中的一行数据复制到工作表 2

vba - activeX 按钮可根据单元格值将工作表 1 中的一行数据复制到工作表 2

问题描述

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

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

所以我希望一旦我将所有数据输入到工作表 1 上的字段中，我可以单击一个 activex 按钮，它会在 A 列的工作表 2 上搜索桌号，然后使用表 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

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

标签： vba

解决方案

类似于下面的代码？我假设桌号在 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

推荐阅读