Kopieren und Einfügen von anderen Arbeitsmappe

Question

Ich versuche, alle Zellen zu kopieren, die blaue Schrift enthalten und kopieren Sie in einer anderen Arbeitsmappe im gleichen Bereich der Quelle, aber ich bin zu diesem Zeitpunkt verloren. Jedes Mal, wenn ich versuche, diesen Code auszuführen, erhalte ich einen Laufzeitfehler.

Sub test2() 

Application.EnableEvents = False 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.Calculation = xlManual 

    Dim FonteA As Workbook, FonteB As Workbook 
    Dim ws As Worksheet 
    Dim vFile As Variant 

    Dim rCell As Range 
    Dim lColor As Long 
    Dim rColored As Range 

    'Set source workbook 
    Set FonteB = ActiveWorkbook 
    'Open the target workbook 
    vFile = Application.GetOpenFilename 
    'if the user didn't select a file, exit sub 
    If TypeName(vFile) = "Boolean" Then Exit Sub 
    Workbooks.Open vFile 
    'Set targetworkbook 
    Set FonteA = ActiveWorkbook 

    FonteB.Worksheets("USD - SCHEDULE A").Activate 
     lColor = RGB(0, 0, 255) 

Cells.CurrentRegion.Select 
    Set rColored = Nothing 
    For Each rCell In Selection 
    If rCell.Font.Color = lColor Then 
     If rColored Is Nothing Then 
       Set rColored = rCell 
     Else 
      Set rColored = Union(rColored, rCell) 
     End If 
    End If 
Next 
If rColored Is Nothing Then 
    MsgBox "No cells match the color" 
Else 
    rColored.Select 
    rColored.Copy 

End If 
Set rCell = Nothing 
Set rColored = Nothing 

FonteA.Worksheets("Matriz_Produto").PasteSpecial Paste:=xlPasteFormats 
FonteA.Worksheets("Matriz_Produto").PasteSpecial Paste:=xlPasteValues 


Application.Calculation = xlAutomatic 
End Sub 

Answer 1

Keine Ahnung, wo der spezifische Fehler herkommt (es sieht aus wie es tatsächlich ein Fehler 1004 sein soll), aber ich bin zu raten von der Verwendung aktiviert und wählen Sie es lösen wird einfach umgeschaltet wird. Versuchen Sie Folgendes:

'Set source workbook 
Set FonteB = ActiveWorkbook 
'Open the target workbook 
vFile = Application.GetOpenFilename 
'if the user didn't select a file, exit sub 
If TypeName(vFile) = "Boolean" Then Exit Sub 
'Set targetworkbook 
Set FonteA = Workbooks.Open(vFile) 

Dim ws As Worksheet 
Set ws = FonteB.Worksheets("USD - SCHEDULE A") 
lColor = RGB(0, 0, 255) 

For Each rCell In ws.Cells.CurrentRegion 
    If rCell.Font.Color = lColor Then 
     If rColored Is Nothing Then 
      Set rColored = rCell 
     Else 
      Set rColored = Union(rColored, rCell) 
     End If 
    End If 
Next