Excel 我需要复制多张图纸中的特定范围，并将其粘贴到最终图纸上

此

工作簿中有24张工作表

。我需要从23张

表格中复制相同的范围，并将它们粘贴到名为“所有调查”的最终表格中。有没有什么方法可以使我不需要像在下面的宏中那样编写那么多代码

Sheets("2").Range("U3:X3").Copy
Sheets("ALL SURVEY").Range("E2").*PasteSpecial xlPasteValues*
Sheets("3").Range("U3:X3").Copy
Sheets("ALL SURVEY").Range("E3").*PasteSpecial xlPasteValues*
Sheets("4").Range("U3:X3").Copy
Sheets("ALL SURVEY").Range("E4").*PasteSpecial xlPasteValues*
Sheets("5").Range("U3:X3").Copy
Sheets("ALL SURVEY").Range("E5").*PasteSpecial xlPasteValues*

如果你能帮助我完成这项艰巨的任务，我将不胜感激
谢谢你
你可以使用一个
For…Next
循环来实现：

子测试仪（）
尺寸n等于长度，c等于范围
设置c=ThisWorkbook.Sheets（“所有调查”）.Range（“E2”）第一个目标单元格
“在床单上循环
对于n=2到23
'将n转换为字符串以获得正确的工作表
“工作表（“2”）与工作表（2）-按工作表名称与索引
使用此工作簿.Sheets（CStr（n））.Range（“U3:X3”）
c、 调整大小（.Rows.Count、.Columns.Count）.值=.Value'设置值
设置c=c.Offset（1，0）'下一个目的地
以
下一个
端接头
您可以执行以下操作：

Sub copyPaste()

Dim survey_sheet As Worksheet, count As Long

count = 1 'start pasting from this row

For Each survey_sheet In ThisWorkbook.Sheets

    If survey_sheet.Name <> "ALL SURVEY" Then
        
        survey_sheet.Range("U3:X3").Copy
        Sheets("ALL SURVEY").Range("E" & count).PasteSpecial xlPasteValues
        count = count + 1
    
    End If
    
Next survey_sheet

End Sub

子复制粘贴（）
将测量表尺寸标注为工作表，按长度计算
计数=1'从此行开始粘贴
对于此工作簿中的每个调查工作表。工作表
如果测量表名称为“所有测量”，则
测量表范围（“U3:X3”）。副本
图纸（“所有测量”）。范围（“E”和计数）。粘贴特殊值
计数=计数+1
如果结束
下一次调查表
端接头

正如您在上面的宏中所看到的，对于
工作簿中的所有工作表，都有一个循环
。当它经历了每一次，它就会结束

If
语句是为了避免在最终工作表中复制/粘贴，
count
变量是为了粘贴在“所有调查”工作表的下一个空行中。
按行复制范围

调整常量部分中的值。请注意
例外列表
。我添加了这两个“有趣”的名称，只是为了表示您必须用
分隔符来分隔它们，不带空格。该列表可以包含不存在的工作表名称，但没有帮助，因此请删除它们，必要时添加其他名称

您可以根据需要调整“复制”范围的大小（例如，
U3:X5
，
Z7:AS13
）。结果将是下一个范围低于下一个范围（按行）
基本上，代码将在名称不在
例外列表
中的所有工作表中循环，并将给定范围的值写入
数组列表
中基于一的二维数组。然后，它将循环遍历
数组列表的数组
，并将值复制到生成的
数据数组
，然后将其值复制到
目标范围

代码

Option Explicit

Sub copyByRows()
    
    Const dstName As String = "ALL SURVEY"
    Const dstFirst As String = "E2"
    Const srcRange As String = "U3:X3"
    Const Delimiter As String = ","
    Dim ExceptionsList As String
    ExceptionsList = dstName & Delimiter & "Sheet500,Sheet1000"
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim dst As Worksheet: Set dst = wb.Worksheets(dstName)
    Dim srCount As Long: srCount = dst.Range(srcRange).Rows.Count
    Dim cCount As Long: cCount = dst.Range(srcRange).Columns.Count
    
    Dim arl As Object: Set arl = CreateObject("System.Collections.ArrayList")
    Dim Exceptions() As String: Exceptions = Split(ExceptionsList, Delimiter)
    
    Dim ws As Worksheet
    For Each ws In wb.Worksheets
        If IsError(Application.Match(ws.Name, Exceptions, 0)) Then
            arl.Add ws.Range(srcRange).Value
        End If
    Next ws
    
    Dim Data As Variant: ReDim Data(1 To arl.Count * srCount, 1 To cCount)
    Dim Item As Variant
    Dim i As Long
    Dim j As Long
    Dim k As Long
    For Each Item In arl
        For i = 1 To srCount
            k = k + 1
            For j = 1 To cCount
                Data(k, j) = Item(i, j)
            Next j
        Next i
    Next Item
    
    dst.Range(dstFirst).Resize(k, cCount).Value = Data
    
End Sub

像往常一样精彩。我曾经遇到过这样的情况，但我想不出来。当然是指CStr的“业务”。谢谢。非常感谢您。如果您可以将xlPasteValues添加到有助于完成整个过程的paste special中，这将非常有帮助，并且对找到此答案的任何人都非常有帮助。完成。谢谢你的建议。