使用工作表名称循环将范围从一个工作表复制到另一个工作表

时间:2014-07-16 23:28:43

标签: excel vba excel-vba

我试图将118张表格编译成两张表(每张59张表)。我在表格中列出了所有工作表名称" 工作表列表。"目前我的代码只返回最后一张表中的表,可能会覆盖所有其他表。对于第一组59张,每张纸上的范围是相同的("A5:F73")。对于接下来的59张,行数在69到68行之间变化,所以我想最简单的方法是编写将在单元格A5(始终)开始选择的代码,选择所有列到F列,然后执行行计数以确定要复制的最后一行。

到目前为止,我已经拼凑了一组具有已知范围的纸张:

Sub ConsolData()

Dim sheet_name As Range
Dim lastrowdata As Long

With Sheets("SB Summary")
    lastrowdata = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
End With

For Each sheet_name In Sheets("Sheet Listing").Range("D6:D64") 
If sheet_name.value = "" Then 
    exit For 

Else
    Sheets(sheet_name.value).select 
    Range("A5:F73").Select 
Selection.Copy

Sheets("SB Summary").select
Range("B2").Offset(lastrowdata).Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False
Sheets(sheet_name.value).select
End If
Next sheet_name

End Sub

我认为问题在于指定要粘贴到的最后一行数据的代码行:

Range("B2").Offset(lastrowdata).Select

问题1:如何正确指定偏移量以防止覆盖以前粘贴的表?

问题2:修改此代码是否更容易处理第二组59个表的动态范围,以便它适用于第一组59个静态/已知范围?

问题3:对于复制的每个范围,我想将表格名称填写到刚刚粘贴的H列中的所有单元格中,以便我知道它来自何处。我该怎么做?

1 个答案:

答案 0 :(得分:0)

在分析中,您的代码会覆盖先前使用最新数据复制的数据 所以最后你只有最后的数据 我已经重新编写了一些代码来解决这个问题,同时也涵盖了动态数据源。

Sub ConsolData()
    Dim sheet_name As Range
    Dim lastrowdata As Long
    '~~> Added this so it looks clean
    Dim ws As Worksheet: Set ws = Sheets("SB Summary")

    With Application
        .ScreenUpdating = False
    End With

    For Each sheet_name In Sheets("Sheet Listing").Range("D6:D64")
        If sheet_name.Value = "" Then
            Exit For
        Else
            '~~> Work on your sheet object directly
            With Sheets(sheet_name.Value)
                '~~> Find the last row of data from target sheet
                '~~> I used this method since you mention Table
                lastrowdata = .Range("A:A").Find("*", [A1], , , , xlPrevious).Row
                .Range("A5:F" & lastrowdata).Copy
                '~~> Find the lastrow in destination sheet
                ws.Range("B:B").Find("*", [B1], , , , xlPrevious) _
                    .Offset(1, 0).PasteSpecial xlPasteValues
            End With
        End If
    Next sheet_name

    With Application
        .ScreenUpdating = False
        .CutCopyMode = False
    End With
End Sub

上面的代码使用范围对象查找方法来查找每次处理工作表对象时的最后几行。
SB摘要中,我们使用偏移方法用数据粘贴最后一行下面的值。
HTH。

顺便说一下,您可能有兴趣阅读以下链接,以进一步改进您的编码。

How to avoid using Select in Excel VBA macros