Получить значения из ячеек с других листов - PullRequest
0 голосов
/ 30 сентября 2019

Я сделал небольшой код VBA, который принесет мне список со всеми именами листов из моей рабочей книги. Мой вопрос: Как я могу получить значения из Sheet7 («B4: B5»), Sheet8 («B4: B5»), Лист ("B4: B5") ..... в лист 6, в котором присутствует следующий код:

Private Sub Worksheet_Activate()
 Call task
End Sub
Sub task()
Call ThisWorkbook.speedOn
    Dim pws As Worksheet
    Dim x, N As Integer
    Dim browLastCol As Range
    Set pws = Sheets("Sheet6")
    'Set browLastCol = pws.Range(Cells(3, 4), Cells(3, 4).End(xlToRight))
    Set browLastCol = pws.Range(Cells(9, 2), Cells(9, 2).End(xlDown))

        x = 9

        pws.Range(Cells(3, 2), Cells(3, 2).End(xlToRight)).Clear


   For Each ws In Worksheets
    If ws.Name <> "Sheet1" Then
     If ws.Name <> "Sheet2" Then
       If ws.Name <> "Sheet3" Then
            If ws.Name <> "Sheet4" Then
             If ws.Name <> "Sheet5" Then
               If ws.Name <> "Sheet6" Then

                    Sheets("Sheet6").Cells(x, 2) = ws.Name ' List woksheets name 

                     x = x + 1
                      Sheets("Sheet6").Range("A3").RowHeight = 40


                      With browLastCol
                               .RowHeight = 26
                               'Some code removed
                     End With


                 End If
                End If
             End If
         End If
      End If
   End If
Next ws
 Call ThisWorkbook.speedOff
End Sub

1 Ответ

1 голос
/ 30 сентября 2019

Другие уже поделились дублирующим решением, но я хотел бы использовать Select Case здесь, чтобы избавиться от всех этих IF операторов.

For Each ws in Worksheets
    Select Case ws.Name
        Case "Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6"
            'Do Nothing (leave this blank)
        Else
            Sheets("Sheet6").Cells(x, 2) = ws.Name 
            x = x + 1
            Sheets("Sheet6").Range("A3").RowHeight = 40

            With browLastCol
                .RowHeight = 26
                'Some code removed
            End With

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