Скопируйте и вставьте код vba - я хочу использовать на нескольких листах

Я новичок в VBA. У меня есть код, который копирует данные, соответствующие определенным критериям с одного листа, на другой мастер-лист. У меня есть несколько других листов, которые я хочу скопировать в мастер. Как мне изменить свой код, чтобы это сделать?

Заранее спасибо.

Sub copyPaste()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Set ws = Sheets("S_Q")
    Set wt = Sheets("master")
    Dim i As Integer
    Dim lr As Integer
    lr = ws.Range("y" & Rows.Count).End(xlUp).Row
    Dim lt As Long

    For i = 1 To lr
    lt = wt.Range("y" & Rows.Count).End(xlUp).Row
        If ws.Range("bz" & i) > 14 Then
        ws.Range("y" & i).EntireRow.Copy wt.Range("a" & lt + 1)
        End If
    Next i
End Sub
0
0
55
3
Перейти к ответу Данный вопрос помечен как решенный

Ответы 3

Не вдаваясь слишком глубоко в специфику самого кода - будут ли критерии одинаковы для всех листов, на которых вы хотите его запустить? И есть ли данные на всех этих листах?

Если это так, и если ваш текущий код делает то, что вам нужно для рабочего листа A, и нам просто нужно расширить его, чтобы также обрабатывать рабочие листы от B до X, тогда вы можете избавиться от своих dim / set ws-строк и вместо этого изменить ваша первая строка

sub copyPaste(ws as worksheet)

Это позволит вам затем использовать отдельную процедуру для вызова этой процедуры для каждого из ваших рабочих листов, на которых она должна быть запущена. Ниже приведен пример использования рабочего листа из исходного кода:

call copyPaste(ThisWorkbook.Sheets("S_Q"))

Спасибо, МакМукерсон. Да, критерии и макет данных такие же, мне просто нужно, чтобы он работал на нескольких листах и ​​вставлял все данные, которые соответствуют критериям из листа a-z, в мастер-лист. Как я уже сказал, я новичок в VBA. Я изменил свой код, чтобы поместить его в первую строку и удалить строки WS, но теперь он не позволяет мне его запускать.

jdwh 31.10.2018 13:36

Получаете ли вы какие-либо конкретные ошибки после этого изменения? Можете ли вы опубликовать, как выглядит ваш код сейчас, чтобы мы могли копнуть глубже?

McMookerson 02.11.2018 12:23

Sub Copy_Filtered_WkShts () Sheets ("master"). Снять пароль: = "пароль" Таблиц ("A_G"). Снять пароль: = "пароль" Таблиц ("F_P"). Снять пароль: = "пароль" Таблиц ("CC ") .Unprotect Password: =" пароль "Dim ws As Worksheet Dim writeRow As Long Sheets (" master "). UsedRange.Offset (1) .ClearContents Application.ScreenUpdating = False For Each ws In ThisWorkbook.Worksheets If (ws.Name <> "master") Затем writeRow = Sheets ("master"). Cells (Rows.count, "y"). End (xlUp) .Row + 1

jdwh 06.11.2018 09:24

При ws .AutoFilterMode = False При .UsedRange. Поле .AutoFilter: = 78, Criteria1: = "> 14", _ Оператор: = xlAnd .Offset (1). Назначение копирования: = Sheets ("master"). Range ("A "& writeRow) Заканчивается на .AutoFilterMode = False Заканчивается на End If Next ws Application.ScreenUpdating = True Sheets (" master "). Защитить пароль: =" password "Sheets (" A_G "). Защитить пароль: =" password "Sheets ("F_P"). Защитить пароль: = "пароль" Таблиц ("CC"). Защитить пароль: = "пароль" End Sub

jdwh 06.11.2018 09:24

Извините, что пришлось разделить 2 комментария, и он продолжает терять форматирование. Извините за задержку с ответом, МакМукерсон.

jdwh 06.11.2018 09:24

Я бы поместил интересующие листы в цикл в массиве и зациклил бы его. Я бы также использовал Union, чтобы собрать квалификационные диапазоны и вставить их за один раз, чтобы быть более эффективным.

Я бы также использовал вспомогательную функцию, чтобы получить последнюю строку и добавить к ней одну, чтобы получить следующую строку.

Кроме того, используйте Long, а не Integer, чтобы избежать потенциального переполнения, поскольку на листе больше строк, чем может обработать Integer.

Option Explicit

Public Sub copyPaste()
    Dim ws As Worksheet, wt As Worksheet, sheetsOfInterest(), unionRng As Range
    Dim i As Long, lastRow As Long, lastRowMaster As Long
    Application.ScreenUpdating = False
    sheetsOfInterest = Array("Sheet1", "Sheet2", "S_Q")

    Set wt = ThisWorkbook.Worksheets("master")

    For Each ws In ThisWorkbook.Worksheets(sheetsOfInterest)

        lastRow = GetLastRow(ws, 25)

        For i = 1 To lastRow

            If ws.Range("BZ" & i) > 14 Then
                If Not unionRng Is Nothing Then
                    Set unionRng = Union(unionRng, ws.Range("bz" & i))
                Else
                    Set unionRng = ws.Range("BZ" & i)
                End If
            End If
        Next i
        If Not unionRng Is Nothing Then
            With wt
                unionRng.EntireRow.Copy .Range("A" & GetLastRow(wt, 1) + 1)
            End With
        End If
        Set unionRng = Nothing
    Next
    Application.ScreenUpdating = True
End Sub

Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
    With ws
        GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
    End With
End Function

Вы пробовали это, пожалуйста?

QHarr 02.11.2018 12:14
Ответ принят как подходящий

Попробовав фильтр на разных столбцах, он работал с некоторыми, а с другими - нет; без видимых причин. Я решил переделать электронные таблицы и поместить столбец для фильтрации в первый столбец. Кажется, пока это работает.

Другие вопросы по теме