Question

我有工作簿即＆＃34;选项＆＃34;，有多张表。数据是表单号。 4到31;在A，B，C和D列中的不同的多行。所有4到31张纸都有不同的名称。在所有4到31张纸中，在C列中有两个名称为＆＃34; CE＆＃34;和＆＃34; PE＆＃34;。我想从列D（在CE前面）找到CE名称和复制数据，并在F列中粘贴相同的表格。同样从列B中找到CE名称复制数据并将G列粘贴到它们各自的表格中。现在再次从列D中找到PE名称复制数据，复制的数据应该在列H中粘贴到它们各自的表单中。再次从B列中找到PE名称复制数据并粘贴到第I列中。粘贴应从第2行开始，即从标题下方开始。

总之，可用数据是4到31张具有不同名称的数据，在ABC和D列中。从所有工作表中找到C列中的两个名称，并将数据从D到F，从B到G，从D到H粘贴从B到I;在各自的表格中。

提前致谢。

我已经尝试了前三张的代码并且工作正常。但是代码会耗费太长时间。期待短代码。我不明白我应该如何在这里发布我的示例代码。有人请帮忙。

    Sub watermasa()
Dim x As String, y As String
x = InputBox("Please Enter the first name")
y = InputBox("Please Enter the second name")

With Sheets("ADANIENT")
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, x
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("ADANIENT").Range("F" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("ADANIENT").Range("G" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, y
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("ADANIENT").Range("H" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("ADANIENT").Range("I" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
End With

With Sheets("ADANIPORTS")
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, x
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("ADANIPORTS").Range("F" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("ADANIPORTS").Range("G" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, y
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("ADANIPORTS").Range("H" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("ADANIPORTS").Range("I" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
End With

With Sheets("APOLLOTYRE")
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, x
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("APOLLOTYRE").Range("F" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("APOLLOTYRE").Range("G" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, y
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("APOLLOTYRE").Range("H" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("APOLLOTYRE").Range("I" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
End With

With Sheets("ARVIND")
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, x
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("ARVIND").Range("F" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("APOLLOTYRE").Range("G" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, y
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("APOLLOTYRE").Range("H" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
    Sheets("APOLLOTYRE").Range("I" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
End With

End Sub

Answer 1

您可以遍历工作表，方法是遍历工作表名称数组或工作表队列中当前位置的序号索引号。

Sub watermasa_by_Name()
    Dim x As String, y As String, lrc As Long, v As Long, vWSs As Variant

    x = InputBox("Please Enter the first name")
    y = InputBox("Please Enter the second name")

    vWSs = Array("ADANIENT", "ADANIPORTS", "APOLLOTYRE", "ARVIND")

    For v = LBound(vWSs) To UBound(vWSs)
        With Sheets(vWSs(v))
            lrc = .Range("C" & Rows.Count).End(xlUp).Row
            .Range("C1:C" & lrc).AutoFilter 1, x
            .Range("D2:D" & lrc).SpecialCells(xlCellTypeVisible).Copy
                .Range("F" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
            .Range("B2:B" & lrc).SpecialCells(xlCellTypeVisible).Copy
                .Range("G" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
            .AutoFilterMode = False
            .Range("C1:C" & lrc).AutoFilter 1, y
            .Range("D2:D" & lrc).SpecialCells(xlCellTypeVisible).Copy
                .Range("H" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
            .Range("B2:B" & lrc).SpecialCells(xlCellTypeVisible).Copy
                .Range("I" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
            .AutoFilterMode = False
        End With
    Next v

End Sub

Sub watermasa_by_Index()
    Dim x As String, y As String, lrc As Long, w As Long

    x = InputBox("Please Enter the first name")
    y = InputBox("Please Enter the second name")

    For w = 4 To 31   ' maybe For w = 4 To sheets.count ?
        With Sheets(w)
            lrc = .Range("C" & Rows.Count).End(xlUp).Row
            .Range("C1:C" & lrc).AutoFilter 1, x
            .Range("D2:D" & lrc).SpecialCells(xlCellTypeVisible).Copy
                .Range("F" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
            .Range("B2:B" & lrc).SpecialCells(xlCellTypeVisible).Copy
                .Range("G" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
            .AutoFilterMode = False
            .Range("C1:C" & lrc).AutoFilter 1, y
            .Range("D2:D" & lrc).SpecialCells(xlCellTypeVisible).Copy
                .Range("H" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
            .Range("B2:B" & lrc).SpecialCells(xlCellTypeVisible).Copy
                .Range("I" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
            .AutoFilterMode = False
        End With
    Next w

End Sub

我不确定您为什么使用With ... End With语句进行复制而不是粘贴操作，但它会稍微清理您的代码。

排序，从多个工作表复制数据并粘贴在不同列的相同工作表中

1 个答案: