主页 / computer / 问题 / 1541409
Accepted
baskar
Asked: 2020-04-13 22:47:27 +0800 CST

如果值匹配，如何复制并粘贴到另一个工作表 - Excel VBA

  • 772

如果 Sheet1 Column F="NUMBERS"，我需要将值从 sheet1 Columns(A:B) 复制并粘贴到 sheet2 Columns(A:B)

Input

A 1 NUMBERS
B 2 TEXT
C 3 NUMBERS
D 4 TEXT
E 5 NUMBERS AND TEXT

OUTPUT
A 1
C 3

目前我使用自动过滤和复制粘贴方法，它有时会给出错误（因为宏很长）。

Sheets("sheet1").Select
ActiveWorkbook.save
Range("A1:J1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$J").AutoFilter Field:=6, Criteria1:="Numbers"
 Columns("A:B").Select
    Selection.Copy

 Sheets("Sheet2").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

所以我需要查找值和复制粘贴方法（基于循环）。

microsoft-excel worksheet-function

1 个回答

  1. Best Answer

    您可以使用此宏将整行复制到另一个工作表中，其中Number的值为Column F.

    Option Explicit

Sub CopyRowWithSpecificText()

Dim Cell As Range

With Sheets(1)
      For Each Cell In .Range("F1:F" & .Cells(.Rows.Count, "F").End(xlUp).Row)
        If Cell.Value = "Numbers" Then

            .Rows(Cell.Row).Copy Destination:=Sheets(2).Rows(Cell.Row)
        End If
    Next Cell
End With
End Sub

    编辑1：

    -如果您不喜欢宏生成空白行，如果Sheet 1要复制的行中有任何行，请使用此代码。

        Sub CopyRowsWithNUMBER()

    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet


    Set Source = ActiveWorkbook.Worksheets("Sheet1")
    Set Target = ActiveWorkbook.Worksheets("Sheet2")

    j = 1     
    For Each c In Source.Range("F1:F20")   
        If c = "Numbers" Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1
        End If
    Next c
    End Sub

    编辑2：

    Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngCheck As Range
    Dim CheckCell As Range
    Dim lRow As Long

    Set rngCheck = Intersect(Me.Columns("F"), Target)

    If Not rngCheck Is Nothing Then

        For Each CheckCell In rngCheck.Cells
            If CheckCell.Value = "Numbers" Then
                With Sheets("sheet2")
                    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                    Me.Cells(CheckCell.Row, "A").Copy Destination:=.Cells(lRow, "A")
                    Me.Cells(CheckCell.Row, "B").Copy Destination:=.Cells(lRow, "B")

                End With
            End If
        Next CheckCell
    End If

End Sub

    这个怎么运作：

    • 复制并粘贴此代码Sheet 1作为标准模块。
    • 只要您输入Numbers的任何单元格，此代码就会将特定行/行Column F的唯一数据复制到。Column A & BSheet 2
    • 目标列应该不同于源。

    注意

    • Sheet Name, Column ( F) 有具体的文字，具体的文字Number可以调整。
    • 将工作簿另存为已启用宏 ( .Xlsm)。
    • 1

相关问题