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