сортировать, копировать данные с нескольких листов и вставлять их на одинаковые листы в разных столбцах

Question

У меня есть рабочая тетрадь, а именно «ОПЦИИ», имеющая несколько листов. Данные приведены в листе №. 4-31; в столбцах A, B, C и D в разных нескольких строках. Все от 4 до 31 листа имеют разные названия. Во всех 4 до 31 листах в столбце C есть два имени под названием «CE» и «PE». Я хочу найти имя CE и скопировать данные из столбца D (который находится перед CE) и вставить в соответствующие теги соответствующие столбцы в столбце F. То же самое найти имя CE, скопировать данные из столбца B и вставить в столбце G их соответствующие листы. Снова теперь найдите данные копирования PE-имени из столбца D, а скопированные данные должны вставить столбец H в соответствующие листы. Снова найдите PE-копию данных копирования из столбца B и вставьте в столбце 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 заявления для копирования и не операция пасты, но он делает очистку вашего кода немного.