将多个工作表合并为一个主工作表；每张纸逐行复制数据

问题描述

我需要一个合并脚本，该脚本将扫描每个选项卡中的每一行，并按顺序将该数据填充到新的主文件中。

例如：

我有3个具有相同标题但行数据不同的选项卡。

主文件将具有：

第2行以及工作表1中的第2行数据
第3行以及工作表2中的第2行数据
第4行，包含工作表3中的第2行数据
第5行以及工作表1中的第3行数据
第6行和第2页中的第3行数据等。

下面的脚本将复制工作表数据并将其合并到一个主工作表中，但是无法按行对数据进行排序。关于如何进行调整以满足我的需求的任何建议？

    Public Sub MergeTabs()

'Merges selected tabs (or all visible tabs if only 1 selected) in current workbook into a new tab

Dim i As Integer,wb As Workbook,w As Window,wsTo As Worksheet,wsFrom As Collection   'Worksheet collection
Dim strScope As String,strNewTab As String
Dim raTarget As Range

Set wb = ActiveWorkbook
Set w = ActiveWindow

Set wsFrom = New Collection

If w.SelectedSheets.Count = 1 Then
    For i = 1 To wb.Worksheets.Count
        If wb.Worksheets(i).Visible Then wsFrom.Add wb.Worksheets(i)
    Next
    strScope = "ALL VISIBLE"
Else
    For i = 1 To w.SelectedSheets.Count
        If w.SelectedSheets(i).Visible Then wsFrom.Add w.SelectedSheets(i)
    Next
    strScope = wsFrom.Count & " SELECTED"
End If

strNewTab = InputBox("Merge data from " & strScope & " sheets to new sheet named:","Merge tabs","All")
If strNewTab = vbNullString Then Exit Sub

Set wsTo = wb.Worksheets.Add(wsFrom(1),Count:=1) 'Add before first selected sheet
wsTo.Name = strNewTab

wsFrom(1).Range("A1").CurrentRegion.copy
wsTo.Range("A1").PasteSpecial xlPasteFormulasAndNumberFormats
Application.CutcopyMode = False

For i = 2 To wsFrom.Count
    wsFrom(i).Range("A2",wsFrom(i).Range("A1").CurrentRegion.Cells(wsFrom(i).Range("A1").CurrentRegion.Cells.Count)).copy
    wsTo.Cells(wsTo.Cells.Rows.Count,1).End(xlUp).Offset(1,0).PasteSpecial xlPasteFormulasAndNumberFormats
    Application.CutcopyMode = False
Next i

wsTo.Range("A1").Select

MsgBox "Merge Done"

End Sub

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

consolidation vba