Попытка заставить скрипт VBA принимать определенные значения ячеек из нескольких листов - PullRequest
0 голосов
/ 28 апреля 2020

Это, вероятно, простая проблема, но я обычно вообще не работаю в VBA. В основном у меня есть лист, который я пытаюсь заполнить именами и некоторыми значениями ячеек из следующих листов. Существует более 50 дополнительных листов, поэтому я пытаюсь создать скрипт go и скопировать значения из указанных ячеек, выгрузить их на свой лист и перейти на следующий лист. Вот снимок листа, который я пытаюсь построить, и я написал в ячейке каждого значения, которое я ищу.

enter image description here

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

Sub EfficiencyReport001()

Dim ws As Worksheet, rep As Worksheet, LastRow As Double
With ThisWorkbook
    For n = 1 To Sheets.Count
        Set ws = Worksheets(n)
        Set rep = Worksheets("001 Efficiency Report")
        LastRow = rep.Range("A3", rep.Range("A3").End(xlDown)).Rows.Count
        If IsNumeric(ws.Name) Then
            If rep.Range("A3") = "" Then
                ws.Range("E20", ws.Range("E20").End(xlDown)).Copy _
                Destination:=rep.Range("A3")
            Else:
                ws.Range("E20", ws.Range("E20").End(xlDown)).Copy _
                Destination:=rep.Range("A" & LastRow)
            End If
        End If
    Next n
End With

End Sub

1 Ответ

1 голос
/ 28 апреля 2020

Я думаю, вы хотите что-то подобное.

  1. L oop через все листы (кроме листа Rep)
  2. Копирование значений из E20 do Last Cell на текущий лист l oop
  3. Вставьте значения на листе Rep в первую доступную ячейку в Column A

Sub Shelter_In_Place()

Dim rep As Worksheet: Set rep = ThisWorkbook.Sheets("001 Efficiency Report")
Dim ws As Worksheet

Dim lr As Long

For Each ws In Worksheets
    If ws.Name <> rep.Name Then
        lr = rep.Range("A" & ws.Rows.Count).End(xlUp).Offset(1).Row
        ws.Range("E20:E" & ws.Range("E" & ws.Rows.Count).End(xlUp).Row).Copy
        rep.Range("A" & lr).PasteSpecial xlPasteValues
    End If
Next ws

End Sub

Если вы просто хотите получить 4 отдельные ячейки из тогда каждый лист можно использовать

Sub Shelter_In_Place()

Dim rep As Worksheet: Set rep = ThisWorkbook.Sheets("001 Efficiency Report")
Dim ws As Worksheet

Dim lr As Long

For Each ws In Worksheets
    If ws.Name <> rep.Name Then

        lr = rep.Range("A" & ws.Rows.Count).End(xlUp).Offset(1).Row

        rep.Range("A" & lr).Value = ws.Range("E20").Value
        rep.Range("B" & lr).Value = ws.Range("AD65").Value
        rep.Range("C" & lr).Value = ws.Range("AF65").Value
        rep.Range("D" & lr).Value = ws.Range("AH65").Value
        rep.Range("E" & lr).Value = ws.Range("AJ65").Value

    End If
Next ws

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...