首页 文章

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

提问于
浏览
-2

我是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

2 回答

  • 0

    我想这就是你所追求的 .

    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
    

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

  • 0

    这可能对您有所帮助:您可以连接字符串 . 含义 Range("A" & 2+i*286) 是VBA的有效范围 . 同样, Sheets("Sheet" & i) 是一张定义明确的表格 . 如果你循环 i ,它应该做你想要的 . 如果你觉得宏的执行速度太慢,我还建议你搜索使用 SelectCopy 的帖子 .

相关问题