Question

我正在尝试从工作簿中的多个特定工作表复制信息，而不将信息从不相关的工作表复制到名为Merge的单个工作表。我要复制信息的工作表名称是：摘要，摘要（1）...摘要（n + 1）。另外，我希望复制的信息在最后一行之后用信息粘贴，而不删除标题行。

我正在使用的代码是来自不同Excel-VBA论坛的各种答案的混合和匹配，所以它不优雅，并且可能由于我对VBA和整个编码的有限理解而导致很多错误。

这是我目前的代码：

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

我非常感谢您的帮助，因为我已经花了几个小时在不同的论坛上针对类似问题做出各种答案，并试图自己解决这个问题。

非常感谢！

Answer 1

检查出来，

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工作簿中的特定工作表并在不同的工作表中复制数据

1 个答案: