创建循环索引并将索引工作表中的数据复制到Master中

时间:2014-01-15 01:14:02

标签: excel vba excel-vba copy

我要做的是从所有工作表复制可变数据范围,但相同的标题,并依次粘贴到主工作表中。每当我点击另一张纸并返回主盘时,原始代码(下面的代码1)就会更新主机中的数据。现在的问题是,工作簿中还有其他工作表,我不希望将其包含在复制过程中。

我编辑了下面收到的代码(下面的代码2),尝试定义运行“loopindex”的开始和结束表,并删除“复制标题”代码行,因为每个工作表的标题都出现在整个主板。显然它不起作用,我想知道是否有人可以提供帮助。

您能否帮我纠正合并代码或提供更优雅的解决方案?感谢。

原始问题 - Excel Forum post

此处的辅助代码 - Stack post LoopIndex

原始代码1

Private Sub Worksheet_Activate()
Dim ws As Worksheet

Application.ScreenUpdating = False
Me.UsedRange.Clear

For Each ws In ThisWorkbook.Worksheets
If ws.Name <> Me.Name Then
    If Range("A1") = "" Then ws.Range("A1").EntireRow.Copy Me.Range("A1")'copy in the headers
    ws.UsedRange.Offset(1).Copy Me.Range("A" & Rows.Count).End(xlUp).Offset(1)'copy data
End If
Next ws

Application.ScreenUpdating = True
End Sub

编辑的CODE 2

Private Sub Worksheet_Activate()
Dim ws As Worksheet

Application.ScreenUpdating = False
Me.UsedRange.Clear

Dim StartIndex, EndIndex, LoopIndex As Integer
   StartIndex = Sheets("Master sheet").Index + 1
   EndIndex = Sheets("End").Index - 1

For LoopIndex = StartIndex To EndIndex

    If Range("A1") = "" Then ws.Range("A1").Offset(1).Copy Me.Range("A" &Rows.Count).End(xlUp).Offset(1)  'copy data
Next LoopIndex

Application.ScreenUpdating = True
End Sub

1 个答案:

答案 0 :(得分:0)

当我只有一个源工作表时,我可以理解为什么你将这个作为工作表激活事件例程对工作表“主列表”。当你有多个源工作表时,我很难看到这很方便。我并不是要求您为自己的决定辩护,因为我对工作簿没有完全的理解,但您可能想重新考虑一下您的方法。我已将下面的例程编码为普通宏,但如果您愿意,可以轻松更改。

我不喜欢假设要加载的工作表从Sheets("Master sheet").Index + 1Sheets("End").Index - 1的方法。虽然我从来没有尝试过这种方法,但我认为这是不稳定的。

我创建了一个隐藏的工作表“加载列表”:

Contents of worksheet "Load List"

这列出了要加载的序列中要加载的工作表。

我已将工作表“Sheet1”填入数据:

Contents of worksheet "Sheet1"

不是很富有想象力的数据,但它可以很容易地检查“主列表”是否加载了正确的数据。工作表“Sheet2”到“Sheet5”具有类似的数据,但数据行的数量不同,“S1”由“S2”,“S3”,“S4”和“S5”代替。

宏运行后,“主列表”的顶部包含:

Top of worksheet "Master list"

您可以看到我已经从第一个工作表加载了所有行,然后只加载了后续工作表中的数据行。

我对我使用的VBA没有太多说法。一旦你知道一个语句存在,通常很容易查找。如有必要请询问。我希望我已经对代码的作用提供了充分的解释。如有必要,再次询问。

Option Explicit
Sub CombinedSelected()

  Dim ColSrcMax As Long
  Dim LoadList As Variant
  Dim RowListCrnt As Long
  Dim RowListMax As Long
  Dim RowMasterNext As Long
  Dim RowSrcMax As Long

  With Worksheets("Load List")
    RowListMax = .Cells(Rows.Count, "A").End(xlUp).Row
    ' Load the values from column A of worksheet "Load List" to LoadList.
    ' The statement converts LoadList to a 2 dimensional array. It is the
    ' equivalent of Redim LoadList(1 To RowListMax, 1 to 1)
    LoadList = .Range(.Cells(1, "A"), .Cells(RowListMax, "A")).Value
  End With

  RowMasterNext = 1

  With Worksheets("Master sheet")
    .Cells.EntireRow.Delete     ' Delete existing contents
  End With

  For RowListCrnt = 2 To RowListMax
    With Worksheets(LoadList(RowListCrnt, 1))
      ' Find last used row and column containing a value.
      ' Warning.  These statements do not allow for any of the source worksheets being empty
      RowSrcMax = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
      ColSrcMax = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
      If RowListCrnt = 2 Then
        ' For first source worksheet only include header row
        .Range(.Cells(1, 1), .Cells(RowSrcMax, ColSrcMax)).Copy _
               Destination:=Worksheets("Master sheet").Cells(RowMasterNext, 1)
        RowMasterNext = RowMasterNext + RowSrcMax
      Else
        ' Data rows only to be copied
        .Range(.Cells(2, 1), .Cells(RowSrcMax, ColSrcMax)).Copy _
               Destination:=Worksheets("Master sheet").Cells(RowMasterNext, 1)
        RowMasterNext = RowMasterNext + RowSrcMax - 1
      End If
    End With
  Next

End Sub