使用工作表名称循环将范围从一张工作表复制到另一张工作表 [英] Copying ranges from one sheet into another using a loop of sheet names

问题描述

我正在尝试将118张表中的表编译成两个表(每个表59个).我在工作表"工作表清单"中列出了所有工作表名称.目前，我的代码仅返回最后一张工作表中的表格，大概覆盖了所有其他表格.对于第一组59张纸，每张纸上的范围是相同的("A5:F73" ).对于接下来的59张纸，行数在69到68行之间变化，因此我想最简单的处理方法是编写将始终在单元格A5处开始选择的代码，将所有列都选择到F列，然后进行行计数以确定要复制的最后一行.

I am attempting to compile tables from 118 sheets into two tables (59 tables each). I have a list of all sheet names within the sheet "Sheet Listing." Currently my code only returns the table from the last sheet, presumably overwriting all the others. For the first set of 59 sheets, the range on every sheet is the same ("A5:F73"). For the next 59 sheets, the number of rows varies between 69 and 68 rows, so I guess the easiest way to deal with that is to write code that would begin a selection at cell A5 (always), select all columns over to column F, then do a row count to determine the last row to copy.

以下是到目前为止我为一组已知范围的工作表拼凑而成的内容:

Below is what I have cobbled together so far for the set of sheets with a known range:

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

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

I think the problem lies with the line of code specifying the last row of data to paste into:

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

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

Question 1: How do I correctly specify the offset in order to prevent overwriting previously pasted tables?

问题2:修改此代码以同时处理第二组59个表的动态范围，使其适用于第一组59个静态/已知范围会更容易吗?

Question 2: Would it be easier to modify this code to also handle the dynamic ranges of the second set of 59 tables so that it works for this first set of 59 static/known ranges?

问题3:对于每个复制的范围，我想将工作表名称填充到H列中刚粘贴的内容旁边的所有单元格中，以便知道它来自何处.我该怎么办?

Question 3: For each range copied, I'd like to fill in the sheet name into all the cells in column H next to what was just pasted so that I know where it came from. How do I do that?

推荐答案

您在分析中正确地认为您的代码会覆盖用最新数据复制的先前数据.
所以最后您将只有最后一个数据.
我已经重新编写了一些代码以解决该问题，该问题也涵盖了动态数据源.

You are correct in your analysis that your code overwrites the previous data copied with the latest one.
So in the end you'll only have the last data.
I've re-written your code a bit to solve that also covering the dynamic data source.

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摘要中，我们使用 Offset将数据粘贴到最后一行下方的方法.
HTH.

Above code uses Range Object Find Method to find the last rows everytime you work on your sheet object.
In the SB Summary we use Offset Method to paste the values below the last row with data.
HTH.

顺便说一句，您可能有兴趣阅读下面的链接，以进一步改善您的编码.

BTW, you might be interested in reading below link to further improve your coding.

如何避免在Excel VBA宏中使用选择"

这篇关于使用工作表名称循环将范围从一张工作表复制到另一张工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！