2016-10-10 16 views
0

ME2Nで始まる開いているファイルをスキャンするマクロを作成しました。マクロは、シートの範囲A2:Px(最後の行)をコピーし、differenzブック(範囲B:Q)のシートに挿入する必要があります。シートME2N [...]の内容を挿入した後、マクロはA列に数式を挿入する必要があります。Excel VBA - シートからコピー(名前をスキャン)して別のシートに挿入します

問題:マクロを実行して式を挿入するとわかります。マクロがシートME2N [...]の内容をコピーしないようです。多分マクロが速すぎて優れていないのでしょうか?

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 

答えて

0

私は問題を再現できませんでしたが、問題なく動作しました。私はこの方法を使用するこの方法が違いを生むかもしれないかどうかわかりません:

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 
関連する問題