Kod, editörle çalışırken çalışır ancak köprü tıklatıldığında değil,

Question

Makromun amacı, bir sayfaya yalnızca bazı bilgileri almak ve bilgileri yeniden girmek zorunda kalmamak için başka birine aktarmaktır. Kod, VBA düzenleyicisi üzerinden çalıştırdığımda, ancak çalışma zamanı hatası '1004' ile sonuçlandığında mükemmel çalışır: Köprü üzerinden çalıştırmayı denediğimde uygulama tanımlı veya nesne tanımlı bir hata. Köprünün doğru makroya bağlı olduğunu biliyorum. Neler oluyor?

Sub Insert_PCO_Row() 

    ' Insert_PCO_Row Macro 
    ' Inserts PCO information into COR log if COR number is entered in COR number column in "Sub Pricing" Worksheet. 

    Dim corNum As Range 
    Dim nextOpen As Range 

    Sheets("Sub Pricing").Select 
    Range("C3").Select 

    Set corNum = Sheet6.Range("A1:A1000") 

    Do Until Selection.Offset(0, -1) = "" 
    'Checks if COR # is entered in "Sub Pricing" tab OR if the COR # is already entered in "COR Log" tab. 
    If Selection.Value = "" Or Application.WorksheetFunction.CountIf(corNum, Selection.Value) > 0 = True Then 
     Selection.Offset(1, 0).Select 
    Else 
     Set nextOpen = Sheet6.Range("A9").End(xlDown).Offset(1, 0) 
     Selection.Copy 
      nextOpen.PasteSpecial xlPasteValues 
     Selection.Offset(0, 1).Copy 
      nextOpen.Offset(0, 1).PasteSpecial xlPasteValues 
     Selection.Offset(0, -2).Copy 
      nextOpen.Offset(0, 2).PasteSpecial xlPasteValues 
     Selection.Offset(0, -1).Copy 
      nextOpen.Offset(0, 3).PasteSpecial xlPasteValues 
     Selection.Offset(0, 7).Copy 
      nextOpen.Offset(0, 7).PasteSpecial xlPasteValues 
     Selection.Offset(1, 0).Select 
    End If 

    Loop 

    Sheets("COR Log").Select 

End Sub 

Answer 1

without using .Select.

Option Explicit 

Sub Insert_PCO_Row() 
    ' Insert_PCO_Row Macro 
    ' Inserts PCO information into COR log if COR number is entered in COR number column in "Sub Pricing" Worksheet. 

    Dim rw As Long, nrw As Long 

    With Worksheets("Sub Pricing") 
     For rw = 3 To .Cells(Rows.Count, 2).End(xlUp).Row 
      With .Cells(rw, 3) 
       If CBool(Len(.Value2)) And _ 
        Not IsError(Application.Match(.Value2, sheet6.Columns(1), 0)) Then 
        nrw = sheet6.Cells(Rows.Count, "A").End(xlUp).Row + 1 
         sheet6.Cells(nrw, 1) = .Value 
         sheet6.Cells(nrw, 2) = .Offset(0, 1).Value 
         sheet6.Cells(nrw, 3) = .Offset(0, -2).Value 
         sheet6.Cells(nrw, 4) = .Offset(0, -1).Value 
         sheet6.Cells(nrw, 8) = .Offset(0, 7).Value 
       End If 
      End With 
     Next rw 
    End With 

    Worksheets("COR Log").Select 

End Sub 

Range .Select yöntemi kullanarak ve operasyonun kaynağını ve hedefini tespit etmek Application.Selection ve ActiveCell özelliklerine dayanarak sadece güvenilir değildir. Benzer bir şekilde, doğrudan değer transferi bir Kopyala/Yapıştır Özel, Değerler işleminden daha verimlidir ve panoya dahil değildir.