Question

我是Excel VBA的新手，我无法找到如何创建一个宏来复制工作簿中每个工作表的数据，并将值粘贴到同一工作簿中的摘要表中，并为每个连续的数据附加下面的数据片材。

我认为我的主要问题是要复制的数据不会在A1中启动。有大量的答案，其中数据从第一列开始，但我无法使其适应没有的数据。

数据位于同一位置，每张纸的大小相同，所以我想我可以为每个数据调暗一个范围，并且我可以管理它。

我需要将它推广到多个工作簿中，每个工作簿中都有不同数量的工作表。每个工作簿中的每个工作表都以通用工作表1，工作表2等方式命名。

我确实在数据中有其他工作表，我不想复制但是我有一段代码可以通过异常工作，只要它循环遍历所有通常不会引起太多问题的工作表

如果已经被问过，我真的很抱歉。我一直在努力寻找一个解决方案好几周，并且幸运地学到了很多其他有用的东西，但我仍然无法找到解决方案。

目前我使用它作为基础，但显然它是非常手动的，我只是无法弄清楚如何使其适应性而不是那么笨重。

我最终会进入循环，但这只是如何处理我遇到的最大问题的基础知识。

感谢阅读！

Sheets("Sheet1").Select
Range("AD9").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MASTER_QI_SUMMARY").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Sheets("Sheet2").Select
Range("AD9").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MASTER_QI_SUMMARY").Select
Range("A288").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Sheets("Sheet3").Select
Range("AD9").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MASTER_QI_SUMMARY").Select
Range("A574").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Sheets("Sheet4").Select
Range("AD9").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MASTER_QI_SUMMARY").Select
Range("A860").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Answer 1

这里有一些可能对你有用的东西：你可以连接字符串。含义Range("A" & 2+i*286)是VBA的有效范围。同样，Sheets("Sheet" & i)是明确定义的表格。如果你循环i，它应该做你想要的。如果您认为宏的执行速度太慢，我还建议您搜索使用Select和Copy的帖子。

Answer 2

我认为这就是你所追求的目标。

Dim wsX As Worksheet, wsS As Worksheet
Dim strSheetsToExclude As String, strArr() As String

Set wsS = Worksheets("MASTER_QI_SUMMARY")

strSheetsToExclude = "Sheet4,Sheet5"

strArr = Split(strSheetsToExclude, ",")
For Each wsX In ActiveWorkbook.Worksheets
    If Not wsX Is wsS _
    And UBound(Filter(strArr, wsX.Name)) = -1 Then
        wsX.Range("AD9").CurrentRegion.Copy
        If IsEmpty(wsS.Range("A2")) Then
            wsS.Range("A2").PasteSpecial xlPasteValues
        Else
            wsS.Range("A" & wsS.Range("A2").End(xlDown).Row + 1).PasteSpecial xlPasteValues
        End If
    End If
Next

只需将要排除的所有工作表添加到逗号分隔的字符串中，即可更改粘贴范围。

将多个工作表中的数据复制到1个工作簿中的摘要表中

2 个答案: