Скопируйте строку только данных, затем перейдите к следующему рабочему листу, если не осталось значений

Question

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

Sub distribute()
Dim sh As Worksheet
Dim destsh As Worksheet
Dim i As Integer

Set destsh = ActiveWorkbook.Worksheets.Add
destsh.Name = "Master"

i = 1
For Each sh In ActiveWorkbook.Worksheets
        ***destsh.Cells(i, 1).Value = sh.Range("B7:B90").SpecialCells(xlCellTypeConstants).Select***
i = i + 1
Next


   ActiveWorkbook.Worksheets("Master").Cells.EntireColumn.ColumnWidth = 30
   ActiveWorkbook.Worksheets("Master").Cells.EntireRow.AutoFit
   ActiveWorkbook.Worksheets("Master").UsedRange.UnMerge
   ActiveWorkbook.Worksheets("Master").UsedRange.WrapText = False


End Sub

Я хочу, чтобы мой код прошел каждый лист в моей книге, скопировал столбец из диапазона B7: B90 и остановился там, где больше нет значений в каждой строке каждого листа, а затем перешел к следующему листу. Некоторые листы имеют 10 ячеек в одном ряду, другие имеют 60; в этом сценарии мой главный файл будет показывать 70 ячеек в столбце A из обеих таблиц. Код создает главную рабочую таблицу, которая компилирует строку B рабочих таблиц в один столбец.

Звездочка, с которой мне нужна помощь, помечена звездочкой

Answer 1

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

Sub distribute()
    Dim sh As Worksheet
    Dim destsh As Worksheet
    Dim i As Integer: i = 1
    Dim sheetName As String: sheetName = ""

    Set destsh = ActiveWorkbook.Worksheets.Add

    'Taking sheet name as input from user
    sheetName = InputBox("Enter sheetname to aggregate data")

    'Checking if sheetname was entered properly
    If (sheetName <> "") Then
        destsh.Name = sheetName
        ActiveWorkbook.Worksheets("Master").Cells.EntireColumn.ColumnWidth = 30
        ActiveWorkbook.Worksheets("Master").Cells.EntireRow.AutoFit
        ActiveWorkbook.Worksheets("Master").UsedRange.UnMerge
        ActiveWorkbook.Worksheets("Master").UsedRange.WrapText = False

        masterSheetRow = 1
        For Each sh In ActiveWorkbook.Worksheets
        'Making sure that the sheet is not the master sheet while getting rows
            If (sh.Name <> sheetName) Then
                For i = 7 To 90
                    If (sh.Cells(i, 2).Value <> "") Then
                        destsh.Cells(masterSheetRow, 1).Value = sh.Cells(i, 2).Value
                        masterSheetRow = masterSheetRow + 1
                    End If
                Next
            End If
        Next
    Else
        MsgBox ("Enter valid sheetname")
    End If
End Sub