问复制一行数据，如果没有值，则移到下一个工作表。
EN

Stack Overflow用户

提问于 2019-05-01 12:23:56

回答 1查看 31关注 0票数 0

我不知道如何创建这部分代码。这是一个模板代码，用于将单元格中的特定值从每个工作表复制到一个主工作表中，该主工作表通常将该数据编译成一行。

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。

我需要帮助的部分已经星号为

excel

vba

人脸核身产品特惠

用户政务民生、金融、通信运营商等场景，接入全面，安全可靠新用户3折起

回答 1

Stack Overflow用户

发布于 2019-05-02 08:12:58

您的代码每次都会创建母版表，这将导致程序在下一次运行中命名工作表时失败。此外，在遍历所有工作表的迭代过程中，您也在读取母版表中的数据，这可能会给出不正确的结果。我可以快速地想到下面的代码。我使用了行和单元格的数字表示法。此外，由于范围是常量的，所以我遍历了您指定的范围。

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