Excel 排序、复制多个工作表中的数据，并将数据粘贴到不同列的同一工作表中

我有一个工作簿，即“选项”，有多张工作表。数据见第4至31页；在不同的多行中的A、B、C和D列中。所有4到31张图纸都有不同的名称。在所有4至31张图纸中，C列有两个名称，分别称为“CE”和“PE”。我希望找到CE名称，并从D列（CE前面）复制数据，然后将数据粘贴到F列的相同表格中。相同的查找CE名称将数据从B列复制，并将数据粘贴到G列的相应表格中。现在再次在D列中找到PE名称复制数据，复制的数据应粘贴到H列中各自的工作表中。再次从B列找到PE名称复制数据并粘贴到I列。粘贴应从第2行开始，即标题下方

总之，可用数据为A、B、C和D列中4至31张具有不同名称的表格。从所有表格的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

---

通过遍历工作表名称的数组或工作表队列中当前位置的顺序索引号，可以循环浏览工作表

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

---

我不知道你为什么用

和。。。以

语句结束复制操作，而不是粘贴操作，但它确实会稍微清理代码。

您应该粘贴代码，然后选择所有代码并点击括号符号。这将把它格式化为代码块。完成

中的（3）表示什么。结束（3）

？我的VBE告诉我，

xlUp

是-4162，但是3生成了正确的行号。Jeeped，两个代码都可以按照我的要求正常工作。最好是第二个我要用的，因为它避免我写所有的表名。还需要一个要求或改进。x=CE和y=PE，是否可以删除输入框并直接运行代码？我不清楚您想如何删除它们。如果要在中硬编码x和y的值，则只需使用类似于

x=“Jeeped”

和

y=“Kishor”

的代码即可。根据我的要求，代码为100%。我对这一准则感到满意。我没有问题了。谢谢