如果满足条件，将复制和粘贴特定单元格的VBA代码 [英] VBA Code to Copy and Paste Specific Cells if Condition is Met

问题描述

如果符合条件(在第29列中使用了锁定"字样)，我正在寻求帮助从一张纸复制和粘贴特定单元格(在第1、5、21、27、29、231列中)，并将其粘贴在第二张纸上.

I am seeking assistance with copying and pasting specific cells (in columns 1, 5, 21, 27, 29, 231) from one sheet if a condition ('lockout' word is used in column 29) is met and paste them in the second sheet.

这就是我从在YouTube上观看其他视频开始的方式-我完全迷路了！

Here is how I started from watching other videos on Youtube - I'm totally lost!

Private Sub CommandButton1_Click()
a = Worksheets("Circuit Data").Cells(Rows.Count, 1).End(xlUp).Row

For i = 8 To a

    If Worksheets("Circuit Data").Cells(i, 29).Text = "Lockout" Then

        Worksheets("Circuit Data").Cells(i, 1, 5, 21, 27, 29, 231).Copy
        Worksheets("Lockout-Est. Cost of Care").Activate
        b = Worksheets("Lockout-Est. Cost of Care").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("lockout-est. Cost of Care").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Circuit Data").Activate

End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Circuit Data").Cells(1, 1).Select

End Sub

推荐答案

这是我解决问题的方法.

This is my approach to solve it.

请阅读代码的注释并进行调整以适合您的需求.

Please read the code's comments and adjust it to fit your needs.

Public Sub CopyData()

    ' Define the object variables
    Dim sourceWorksheet As Worksheet
    Dim targetWorksheet As Worksheet

    ' Define other variables
    Dim searchString As String

    Dim lastSourceRow As Long
    Dim startSourceRow As Long
    Dim lastTargetRow As Long
    Dim sourceRowCounter As Long
    Dim columnToEval As Long
    Dim columnCounter As Long

    Dim columnsToCopy As Variant

    ' Adjust the worksheets names
    Set sourceWorksheet = ThisWorkbook.Worksheets("Circuit Data")
    Set targetWorksheet = ThisWorkbook.Worksheets("Lockout-Est. Cost of Care")

    ' Define the number of columns to copy from one sheet to the other
    columnsToCopy = Array(1, 5, 21, 27, 29, 231)

    ' Set the string you're going to evaluate
    searchString = "Lockout"

    ' Adjust the initial row where data is going to be evaluated
    startSourceRow = 8

    ' Adjust the column where you evaluate if condition is met
    columnToEval = 29

    ' Find the number of the last row in source sheet (notice that this search in column A = 1)
    lastSourceRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row

    For sourceRowCounter = startSourceRow To lastSourceRow

        ' Evaluate if criteria is met in column 29
        If sourceWorksheet.Cells(sourceRowCounter, columnToEval).Value = searchString Then

            ' Get last row on target sheet (notice that this search in column A = 1)
            lastTargetRow = targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).Row

            For columnCounter = 0 To UBound(columnsToCopy)

                ' You don't need to use copy and paste if values is all that you're passing
                targetWorksheet.Cells(lastTargetRow, columnsToCopy(columnCounter)).Offset(1, 0).Value = sourceWorksheet.Cells(sourceRowCounter, columnsToCopy(columnCounter)).Value

            Next columnCounter

        End If

    Next sourceRowCounter

    ' If this is necessary...
    sourceWorksheet.Activate

End Sub

---

已添加:

1. 搜索多个字符串
2. 在targetWorksheet中定义与sourceWorksheet不同的列

新代码(带注释):

Option Explicit

Public Sub CopyData()

    ' Define the object variables
    Dim sourceWorksheet As Worksheet
    Dim targetWorksheet As Worksheet

    ' Define other variables
    Dim searchStrings() As String ' -> Updated to hold multiple values

    Dim lastSourceRow As Long
    Dim startSourceRow As Long
    Dim lastTargetRow As Long
    Dim sourceRowCounter As Long
    Dim columnToEval As Long
    Dim columnCounter As Long
    Dim searchCounter As Long ' -> New

    Dim columnsToCopy As Variant
    Dim columnsDestination As Variant

    ' Adjust the worksheets names
    Set sourceWorksheet = ThisWorkbook.Worksheets("Circuit Data")
    Set targetWorksheet = ThisWorkbook.Worksheets("Lockout-Est. Cost of Care")

    ' Define the number of columns to copy from one sheet to the other
    columnsToCopy = Array(1, 5, 21, 27, 29, 231)
    columnsDestination = Array(1, 2, 3, 4, 5, 6) ' -> This must have the same items' quantity as columnsToCopy

    ' Set the string you're going to evaluate
    searchStrings = Split("Lockout,DJJ lockout", ",") ' -> Here the values are separated by commas in one single string (be careful of spaces between commas)

    ' Adjust the initial row where data is going to be evaluated
    startSourceRow = 8

    ' Adjust the column where you evaluate if condition is met
    columnToEval = 29

    ' Find the number of the last row in source sheet (notice that this search in column A = 1)
    lastSourceRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row

    For sourceRowCounter = startSourceRow To lastSourceRow

        ' New -> Where need to iterate through each of the values in the search string array
        For searchCounter = 0 To UBound(searchStrings)

            ' Evaluate if criteria is met in column 29
            If sourceWorksheet.Cells(sourceRowCounter, columnToEval).Value = searchStrings(searchCounter) Then

                ' Get last row on target sheet (notice that this search in column A = 1)
                lastTargetRow = targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).Row

                For columnCounter = 0 To UBound(columnsToCopy)

                    ' You don't need to use copy and paste if values is all that you're passing
                    ' -> New See that I replaces the first columnsToCopy for columnsDestination
                    targetWorksheet.Cells(lastTargetRow, columnsDestination(columnCounter)).Offset(1, 0).Value = sourceWorksheet.Cells(sourceRowCounter, columnsToCopy(columnCounter)).Value

                Next columnCounter

            End If

        Next searchCounter

    Next sourceRowCounter

    ' If this is necessary...
    sourceWorksheet.Activate

End Sub

这篇关于如果满足条件，将复制和粘贴特定单元格的VBA代码的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！