Excel VBA - Copy from a sheet (scan for name) then insert it in another sheet

Question

I've made a macro that scans for a open file beginning with ME2N. The macro should then copy the range A2:Px (last row) in the sheet and insert it in the sheet of a differenz workbook (range B:Q). After inserting the content of the sheet ME2N[...] the macro should insert a formula in column A.

Problem: I can see when I run the macro that it inserts a formula but nothing more. It seems like the macro doesn't copy the content of the sheet ME2N[...]. Maybe the macro is too fast for 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

Tim Edwards Tim Edwards · Accepted Answer · 2016-10-10T08:39:15

I couldn't recreate your issue, it worked fine for me. I don't know whether this method of using the formula may make a difference though:

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 - Copy from a sheet (scan for name) then insert it in another sheet

1 Answers