Question

我正在尝试将数据从多个标签复制到一个标签。首先需要过滤数据，然后将其从不同的选项卡复制到新的选项卡。来自不同标签的数据（行数随机）应在新标签内是连续的。由于数据的大小，它分为多个选项卡。因此，首先不能将标签合并到一个标签中。

我遇到以下困难，需要帮助：

在第二个标签中，我不需要复制数据标题。可以将任何命令添加到代码中吗？
当前代码未复制所有四个标签，我不太确定出什么问题
我的活动表可以是通用命令，而不是像ActiveSheet.Range("$A$1:$U$493692")这样的特定命令吗？

请参见下面的代码

Sub Filter_FSI()
'
' Filter_FSI Macro
'

'
    Dim lastRow As String

    lastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row + 1

    Sheets("Train 3-8").Select
    ActiveSheet.Range("$A$1:$U$493692").AutoFilter Field:=4, Criteria1:="FSI"
    ActiveSheet.AutoFilter.Range.Copy
    Sheets("Sheet1").Select
    Range("A1").Select
    Sheets("Sheet1").Paste
    Sheets("Train 9-14").Select
    ActiveSheet.Range("$A$1:$U$539243").AutoFilter Field:=4, Criteria1:="FSI"
    ActiveSheet.AutoFilter.Range.Copy
    Sheets("Sheet1").Select
    Range("A" & lastRow).Select
    ActiveSheet.Paste
    Sheets("Train 15-25").Select
    ActiveSheet.Range("$A$1:$U$528028").AutoFilter Field:=4, Criteria1:="FSI"
    ActiveSheet.AutoFilter.Range.Copy
    Sheets("Sheet1").Select
    Range("A" & lastRow).Select
    ActiveSheet.Paste
    Sheets("Train 27-41").Select
    ActiveSheet.Range("$A$1:$U$298055").AutoFilter Field:=4, Criteria1:="FSI"
    ActiveSheet.AutoFilter.Range.Copy
    Sheets("Sheet1").Select
    Range("A" & lastRow).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Copy
    Windows("Train Data JULY_Sam Edit.xlsb").Activate
End Sub

Answer 1

所以我在您的代码中注意到了几件事-您将lastrow声明为string，但实际上它应该是long，因为它代表一个数字。

就我个人而言，我不喜欢自动过滤-就像上面的Peh所述，您希望避免使用Select和Copy / Paste。请在下面尝试此解决方案-这是我个人喜欢做的事情。我们遍历所有工作表，然后遍历D列中的每个单元格-如果它等于“ FSI”，则将其带到Sheet1：

Option Explicit
Sub Filter_FSI()

Dim sht As Worksheet, sht2 As Worksheet
Dim lastrow As Long, i As Long, j As Long, k As Long
Dim myworksheets As Variant

Set sht = ThisWorkbook.Worksheets("Sheet1")
myworksheets = Array("Train 3-8", "Train 9-14", "Train 15-25", "Train 27-41")

'Bring in headers
sht.Range("A1:U1").Value = Worksheets("Train 3-8").Range("A1:U1").Value
k = 2

For i = 0 To UBound(myworksheets)
    Set sht2 = Worksheets(myworksheets(i))
    lastrow = sht2.Cells(sht2.Rows.Count, 4).End(xlUp).Row

    For j = 2 To lastrow
        If sht2.Cells(j, 4).Value = "FSI" Then
            sht.Range("A" & k & ":U" & k).Value = sht2.Range("A" & j & ":U" & j).Value
            k = k + 1
        End If
    Next j
Next i

End Sub

如何将数据从多个选项卡复制到一个选项卡？

1 个答案: