从多张工作表复制Excel不使用vba

我将这些代码组合在一起，将不同的范围从多张图纸复制到母版图纸。但是，对于CopyRNG7，它不会覆盖copyrng6，而不是位于copyrng6之下

Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng1 As Range
Dim CopyRng2 As Range
Dim CopyRng3 As Range
Dim CopyRng4 As Range
Dim CopyRng5 As Range
Dim CopyRng6 As Range
Dim CopyRng7 As Range
Dim cell As Range
Dim Row As Range



With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With


Application.DisplayAlerts = False

Set DestSh = Sheets("Main")


'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> DestSh.Name And sh.Name <> "Main" And sh.Name <> "Master" Then

        'Find the last row with data on the DestSh
        Last = LastRow(DestSh)

        'Fill in the range that you want to copy
        Set CopyRng1 = sh.Range("B3")
        Set CopyRng2 = sh.Range("C3")
        Set CopyRng3 = sh.Range("D3")
        Set CopyRng4 = sh.Range("G3")
        Set CopyRng5 = sh.Range("C5")
        Set CopyRng6 = sh.Range("A8:j25")
        Set CopyRng7 = sh.Range("A28:j44")

        'Test if there enough rows in the DestSh to copy all the data
        If Last + CopyRng1.Rows.Count > DestSh.Rows.Count Then
            MsgBox "There are not enough rows in the Destsh"
            GoTo ExitTheSub
        End If

        'This example copies values/formats, if you only want to copy the
        'values or want to copy everything look at the example below this macro
        CopyRng1.Copy
        With DestSh.Cells(Last + 1, "A")
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
        CopyRng2.Copy
        With DestSh.Cells(Last + 1, "B")
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
        CopyRng3.Copy
        With DestSh.Cells(Last + 1, "C")
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With

         CopyRng4.Copy
        With DestSh.Cells(Last + 1, "D")
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
         CopyRng5.Copy
        With DestSh.Cells(Last + 1, "E")
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With


        CopyRng6.Copy
        With DestSh.Cells(Last + 1, "F")
            .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
        End With
         CopyRng7.Copy
        With DestSh.Cells(Last + 1, "F")
            .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
        End With


    End If
Next

 ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
                        After:=sh.Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
On Error GoTo 0
End Function

多工作表（）的子副本范围
将sh设置为工作表
将DestSh设置为工作表
持续时间一样长
调暗复印机G1 As范围
Dim CopyRng2 As范围
调暗COPYRG3 As范围
调暗CopyRng4 As范围
调暗CopyRng5 As范围
Dim CopyRng6 As范围
调暗CopyRng7 As范围
暗淡单元格作为范围
暗行作为范围
应用
.ScreenUpdate=False
.EnableEvents=False
以
Application.DisplayAlerts=False
Set DestSh=图纸（“主”）
'循环浏览所有工作表并将数据复制到DestSh
对于ActiveWorkbook.工作表中的每个sh
如果sh.Name DestSh.Name和sh.Name“Main”和sh.Name“Master”，则
'查找DestSh上包含数据的最后一行
最后一行=最后一行（DestSh）
'填写要复制的范围
设置CopyRng1=sh.Range（“B3”）
设置CopyRng2=sh.Range（“C3”）
设置CopyRng3=sh.Range（“D3”）
设置CopyRng4=sh.Range（“G3”）
设置CopyRng5=sh.Range（“C5”）
设置CopyRng6=sh.Range（“A8:j25”）
设置CopyRng7=sh.Range（“A28:j44”）
'测试DestSh中是否有足够的行来复制所有数据
如果Last+CopyRng1.Rows.Count>DestSh.Rows.Count，则
MsgBox“Destsh中没有足够的行”
下地狱
如果结束
'如果您只想复制
'值或要复制所有内容请参见此宏下面的示例
复制。复制
带目标单元格（最后+1，“A”）
.Paste特殊XLPaste值
Application.CutCopyMode=False
以
CopyRng2.Copy
带目标单元格（最后+1，“B”）
.Paste特殊XLPaste值
Application.CutCopyMode=False
以
复印件3.复印件
带目标单元格（最后+1，“C”）
.Paste特殊XLPaste值
Application.CutCopyMode=False
以
CopyRng4.复制
带目标单元格（最后+1，“D”）
.Paste特殊XLPaste值
Application.CutCopyMode=False
以
复制，复制
带目标单元格（最后+1，“E”）
.Paste特殊XLPaste值
Application.CutCopyMode=False
以
复制6.复制
带目标单元格（最后+1，“F”）
.Paste特殊粘贴：=XLPasteValues和NumberFormats
Application.CutCopyMode=False
以
复制7.复制
带目标单元格（最后+1，“F”）
.Paste特殊粘贴：=XLPasteValues和NumberFormats
Application.CutCopyMode=False
以
如果结束
下一个
退出主题：
应用程序。转到DestSh。单元格（1）
'自动调整DestSh工作表中的列宽
DestSh.Columns.AutoFit
应用
.ScreenUpdate=True
.EnableEvents=True
以
端接头
函数LastRow（sh作为工作表）
出错时继续下一步
LastRow=sh.Cells.Find（内容：=“*”_
之后：=sh.Range（“A1”）_
看：=xlPart_
LookIn:=xl公式_
搜索顺序：=xlByRows_
搜索方向：=xlPrevious_
MatchCase:=False）。行
错误转到0
端函数

---

提前谢谢。这是我的第一个问题，对于任何错误或困惑，我都会提前道歉。如果有人问我，我可以提供更多的解释。谢谢

请刷新介于6和7 copy之间的

last

变量，以便在复制6后刷新工作表上新的最后一行：

    CopyRng6.Copy
    With DestSh.Cells(Last + 1, "F")
        .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End With

    last = LastRow(DestSh)

     CopyRng7.Copy
    With DestSh.Cells(Last + 1, "F")
        .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End With

---

你好，斯科特，我把它改成了一个问题，谢谢。这是第一次，所以我道歉。在

CopyRng6

和

CopyRng7

之后，您有相同的行：

和DestSh.Cells（最后+1，“F”）

，所以当然7将覆盖6:）我想将CopyRng7复制到DestSh的F中，但是，一旦粘贴了copyrng6并将其置于copyrng6之下，则必须刷新

last

变量以获取新的lastrow@Navkaur伟大的请将问题标记为已回答，以便其他人能从中受益。如何将问题标记为已回答？通过选择勾号？你好，斯科特，请您也看看我的其他问题，我将非常感谢。