循环浏览excel工作簿中的特定工作表并复制不同工作表中的数据 [英] Looping through specific sheets in an excel work book and copying data in different work sheet

问题描述

我正在尝试从工作簿中的几个特定工作表中复制信息，而不是从无关的工作表中复制信息到一个称为合并"的工作表中.我要从中复制信息的工作表的名称是:摘要，摘要(1)...摘要(n + 1). 另外，我希望将复制的信息粘贴到带有信息的最后一行之后，而不删除标题行.

I'm trying to copy information from several specific sheets in a workbook, without copying information from irrelevant sheets, to a single sheet called Merge. The name of the sheets where i want to copy the information from is: Summary, Summary(1)... Summary(n+1). In addition, i want the copied information to be pasted after the last row with information and without deleting the header line.

我使用的代码是来自不同Excel-VBA论坛中各种答案的混合和匹配，因此它不太雅致，并且可能由于我对VBA和整体编码的有限理解而导致很多错误.

The code i'm using is a mix and match from various answers in different Excel-VBA forums so it's not elegant and probably has lots of errors caused by my limited understanding of VBA and coding as a whole.

这是我当前拥有的代码:

This is the code i currently have:

Sub Copy_1()
Dim SourceRange As Range, DestRange As Range
Dim DestSheet As Worksheet, Lr As Long

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

'Deleting the information from sheet ñéëåí
Sheets("Merge").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

'loop through all worksheets and copy the data to the DestSh
For Each sh In ThisWorkbook.Worksheets

    'Loop through all worksheets except the Merge worksheet and the
    'Information worksheet, you can add more sheets to the array if you want.
   If IsError(Application.Match(sh.Name, _
                                 Array(DestSheet.Name, "Merge"), 0)) Then
'fill in the Source Sheet and range
'Set SourceRange = Sheets("Summary").Range("A2:L100")
Set SourceRange = sh.Range("A2:N100")
SourceRange.Copy

'Fill in the destination sheet and call the LastRow
'function to find the last row
Set DestSheet = Sheets("øéëåæ")
Lr = LastRow(DestSheet)

'With the information from the LastRow function we can
'create a destination cell and copy/paste the source range
Set DestRange = DestSheet.Range("A" & Lr + 1)
'Set DestRange = DestSheet.Range("A" & Last + 1)
'End If

'SourceRange.Copy DestRange
SourceRange.Copy
        With DestSheet.Cells(2, Last + 1)
            .PasteSpecial 8    ' Column width
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With
Next

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

非常感谢您的帮助，因为我已经花费了数小时在不同论坛上针对类似问题进行各种回答，并尝试自行解决.

I would greatly appreciate your help as i've already spent hours going through various answers on similar issues in different forums and trying to solve this on my own.

非常感谢！

推荐答案

签出，

Sub Button1_Click()
    Dim ws As Worksheet, sh As Worksheet, pRng As Range
    Set ws = Sheets("Merge")

    For Each sh In Sheets
        If sh.Name <> ws.Name Then    'if sheet name does not ="Merge"
            If sh.Name <> "Jimmy Changa" Then    'just an example if you didn't want to include a sheet
                sh.Range("A2:N100").Copy
                Set pRng = ws.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                pRng.PasteSpecial Paste:=xlPasteFormats
                pRng.PasteSpecial Paste:=xlPasteValues
            End If
        End If
        Application.CutCopyMode = 0
    Next sh
    Columns("A:G").EntireColumn.AutoFit
End Sub

这篇关于循环浏览excel工作簿中的特定工作表并复制不同工作表中的数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！