我如何使用 VBA 复制包含特定值的单元格的行并将它们粘贴到新的 sheet 中以形成新的 table？

Question

这周刚开始使用 VBA 和宏的新手，我正在尝试将具有特定值的行复制到另一个 sheet 以形成新的 table . 我的想法是，只要我连续有一个 A（如图所示），我就必须复制该行并将其插入一个新的 sheet。 table 中有 2368 行，所以我尝试了以下代码，但它仍然无法正常工作。感谢您的帮助！

Sub find_copy_row()

  Sheets.Add.Name = "Equilibrage.actif"

  Dim Rng As Range
  Dim Workrng As Range

  For i = 2 To i = 2368

    Set Workrng = Range(Rows("i"))

    For Each Rng In Workrng
      If Rng.Value = "A" Then

        Rows("i").Select
        Selection.Copy

        Sheets("Equilibrage.actif").Activate
        Rows("1:1").Insert    
   
      End If
    Next
   
    i = i + 1

  Next    
End Sub

Answer 1

你的代码由于各种原因将无法运行（你的For循环语句不正确，你Activate一个sheet但从未重新Activate原来的，和更多）。所以这里有一个例子，可以让你开始使用一些基本的“规则”，当你在 VBA.

中编码时要遵守这些规则。

Option Explicit

Sub test()
    CopyRowsWith "A"
End Sub

Sub CopyRowsWith(checkValue As Variant)
    Dim destinationSheet As Worksheet
    Set destinationSheet = ThisWorkbook.Sheets.Add
    destinationSheet.Name = "Equilibrage.actif"
    
    Dim destRow As Long
    destRow = 1
    
    Dim sourceSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    
    Dim lastRow As Long
    Dim lastColumn As Long
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row
    lastColumn = sourceSheet.Cells(1, sourceSheet.Columns.Count).End(xlToLeft).Column
    
    Dim i As Long
    Dim j As Long
    For i = 2 To lastRow
        For j = 1 To lastColumn
            If sourceSheet.Cells(i, j).Value = checkValue Then
                sourceSheet.Cells(i, j).EntireRow.Copy _
                        Destination:=destinationSheet.Range("A" & destRow)
                destRow = destRow + 1
                Exit For 'immediately skip to the next row
            End If
        Next j
    Next i
End Sub

Always use Option Explicit
始终清楚worksheet or range is being referenced
使用中间变量（例如lastRow）来帮助您提高代码的可读性。是的，这是几行额外的代码。但在许多情况下，它可以使你的代码更快（如果这是一个问题），但你会发现可读性在长期运行.
Avoid using Select 在你的代码中
为您的变量命名，尽可能清楚地说明您要做什么。

祝你好运！

Answer 2

欢迎 Sakamoto，希望这对你有用（我注释掉了工作表添加，因为如果工作表已经存在，它将失败，你应该在添加之前检查它是否存在）

Sub RowCopy()

  ' Sheets.Add.Name = "Equilibrage.actif"
  Worksheets("Sheet3").Activate

  lastRow = Worksheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row
  out_row = 2
  
  For in_row = 2 To lastRow
   q = Range("i" & in_row).Value
   If (q = "A") Then
    Range(in_row & ":" & in_row).Copy
    Worksheets("Equilibrage.actif").Range(out_row & ":" & out_row).Insert
    out_row = out_row + 1
   End If
  Next in_row
End Sub

我如何使用 VBA 复制包含特定值的单元格的行并将它们粘贴到新的 sheet 中以形成新的 table？

How can i use VBA to copy rows with cells containing a certain value and paste them in a new sheet to form a new table?

excel

vba

rows