时间戳

首页 > 解决方案 > 如何根据文本值在工作表之间复制行

excel - 如何根据文本值在工作表之间复制行

问题描述

我正在尝试根据行的 H 列中特定文本值（“是”）的出现将整行从一个工作表复制到另一个工作表。

我找到了此代码，并希望将其更改为在工作簿中搜索多个工作表。我已经阅读了有关使用数组的信息，但我不确定如何实现它。

如果需要更改，则不需要检查前 1000 行，整张工作表都可以。

谢谢你。

Sub CopyYes()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet

    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Jan 19")
    Set Target = ActiveWorkbook.Worksheets("Storage")

    J = 1     ' Start copying to row 1 in target sheet
    For Each c In Source.Range("H1:H1000")   ' Do 1000 rows
        If c = "yes" Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1
        End If
    Next c
End Sub

标签： excelvba

解决方案

我只会过滤您的范围，然后复制过滤后的数据，如下所示：

Option Explicit
Sub CopyYes()

    Dim LastRow As Long, Col As Long, Lrow As Long
    Dim Source As Worksheet, Target As Worksheet
    Dim arrws
    Dim HandleIt As Variant

    ' Change worksheet designations as needed
    Set Target = ThisWorkbook.Worksheets("Storage")

    arrws = Array("Jan 19", "Feb 19") 'add all the worksheets you need to loop through

    For Each Source In ThisWorkbook.Worksheets

        HandleIt = Application.Match(Source.Name, arrws, 0)
        If Not IsError(HandleIt) Then
            With Source
                .UsedRange.AutoFilter Field:=8, Criteria1:="yes"
                LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
                Col = .Cells(1, .Columns.Count).End(xlToLeft).Column
                Lrow = Target.Cells(Target.Rows.Count, 1).End(xlUp).Row + 1
                .Range("A2", .Cells(LastRow, Col)).SpecialCells(xlCellTypeVisible).Copy Target.Range("A" & Lrow)
            End With
        End If
    Next Source

End Sub

您将一次获得相同的输出，避免循环。

推荐阅读