Excel VBA-从工作表复制（扫描名称），然后将其插入另一工作表

Question

我已经制作了一个宏，用于扫描以ME2N开头的打开文件。 然后宏应在工作表中复制范围A2：Px（最后一行），并将其插入差异化工作簿的工作表中（范围B：Q）。 在插入工作表ME2N [...]的内容之后，宏应在A列中插入一个公式。

问题：运行宏后，我看到它会插入一个公式，仅此而已。 似乎宏没有复制工作表ME2N [...]的内容。 也许宏对于Excel来说太快了？

Sub CopyData()
Dim Wb1 As Workbook, wb2 As Workbook, wB As Workbook
Dim rngToCopy As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If MsgBox("Alte Daten löschen und neue übertragen?", vbYesNo) = vbNo Then Exit Sub
Worksheets("Input").Range("A5:Q2500").clearcontents

For Each wB In Application.Workbooks
    If Left(wB.Name, 4) = "ME2N" Then
        Set Wb1 = wB
        Exit For
    End If
Next

If Not Wb1 Is Nothing Then
    Set wb2 = ThisWorkbook

    With Wb1.Sheets(1)
        Set rngToCopy = .Range("A2:P2", .Cells(.Rows.Count, "A").End(xlUp))
    End With
    wb2.Sheets(2).Range("B5:Q5").Resize(rngToCopy.Rows.Count).Value = rngToCopy.Value
End If

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Range("A5").Formula = "=IF(INDIRECT(""B""&ROW())="""","""",CONCATENATE(INDIRECT(""B""&ROW()),""/"",INDIRECT(""C""&ROW()),""/"",INDIRECT(""F""&ROW())))"
Range("A5").Copy
Range("A5:A2500").PasteSpecial (xlPasteAll)

If Application.CalculationState = xlDone Then
Range("A5:Q2500").Copy
Range("A5:Q2500").PasteSpecial xlPasteValues
End If

End Sub

Answer 1

我无法重提您的问题，对我来说效果很好。 我不知道这种使用公式的方法是否会有所作为：

Sub CopyData()
Dim Wb1 As Workbook, wb2 As Workbook, wB As Workbook
Dim rngToCopy As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If MsgBox("Alte Daten löschen und neue übertragen?", vbYesNo) = vbNo Then Exit Sub
Worksheets("Input").Range("A5:Q2500").ClearContents

For Each wB In Application.Workbooks
    If Left(wB.Name, 4) = "ME2N" Then
        Set Wb1 = wB
        Exit For
    End If
Next

If Not Wb1 Is Nothing Then
    Set wb2 = ThisWorkbook

    With Wb1.Sheets(1)
        Set rngToCopy = .Range("A2:P2", .Cells(.Rows.Count, "A").End(xlUp))
    End With
    wb2.Sheets(2).Range("B5:Q5").Resize(rngToCopy.Rows.Count).Value = rngToCopy.Value
End If

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Range("A5").Formula = "=IF(INDIRECT(""B""&ROW())="""","""",CONCATENATE(INDIRECT(""B""&ROW()),""/"",INDIRECT(""C""&ROW()),""/"",INDIRECT(""F""&ROW())))"
Range("A5").AutoFill Destination:=ActiveCell.Range("A1:A2500")

If Application.CalculationState = xlDone Then
    Range("A5:Q2500").Value = Range("A5:Q2500").Value
End If

End Sub