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个单元格；在这种情况下，我的主文件将在两个工作表的A列中显示70个单元格。该代码创建一个主工作表，该工作表将工作表的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

如果仅剩一行数据，请复制一行，如果没有剩余值，请继续移至下一个工作表

1 个答案: