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

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

1 个答案: