Copy from one workbook to another
 

I want to copy cells f,l,g from workbook bonus to workbook Destination. But
only cells from rows where column A er equal a or c.
I got this code here but doesn't work:
Sub Control()

Workbooks.Open Filename:="c:\bonus.xls"
Workbooks.Open Filename:="c:\Destination.xls"
CopyData 6, "A"
CopyData 7, "B"
CopyData 12, "C"

End Sub
Sub CopyData(col As Long, target As String)
Dim iLastRow As Long

With Workbooks("bonus.xls").Worksheets("Ark1")
iLastRow = .Cells(.Rows.Count, col).End(xlUp).Row
For i = 1 To iLastRow
If .Cells(i, col).Value = "a" Or _
.Cells(i, col).Value = "c" Then

Workbooks("Destination.xls").Worksheets("Ark1").Ce lls(i, target) = _
.Cells(i, col).Value
End If
Next i
End With

End Sub

Copy from one workbook to another
 

try the code
Sub test()
Dim wbBonus As Workbook, wbDest As Workbook
Dim a(), i As Long, r As Range, x
Workbooks.Open Filename:="c:\bonus.xls"
Workbooks.Open Filename:="c:\Destination.xls"
Set wbBonus = Workbooks("bonus.xls")
Set wbDest = Workbooks("Destination.xls")
With wbBonus.Sheets("Ark1")
x = Application.CountIf(.Range("a:a"), "a") + _
Application.CountIf(.Range("a:a"), "c")
ReDim a(1 To x, 1 To 3)
For Each r In .Range("a1", .Range("a65536").End(xlUp))
If r.Value = "a" Or r.Value = "c" Then
i = i + 1: a(i, 1) = r.Offset(, 5)
a(i, 2) = r.Offset(, 11): a(i, 3) = r.Offset(, 6)
End If
Next
End With
With wbDest.Sheets("Ark1")
.Cells.Clear
.Range("a2").Resize(UBound(a, 1), UBound(a, 2)).Value = a
End With
Erase a
End Sub

Copy from one workbook to another
 

Thanks Seiya your code work well
I need one more condition:
column c should be equal number 50.

Copy from one workbook to another
 

Thanks Seiya your code work well
I need one more condition:
column c should be equal number 50.

Copy from one workbook to another
 

try
Sub test()
Dim wbBonus As Workbook, wbDest As Workbook
Dim a(), i As Long, r As Range, x
Workbooks.Open Filename:="c:\bonus.xls"
Workbooks.Open Filename:="c:\Destination.xls"
Set wbBonus = Workbooks("bonus.xls")
Set wbDest = Workbooks("Destination.xls")
With wbBonus.Sheets("Ark1")
x = Application.CountIf(.Range("a:a"), "a") + _
Application.CountIf(.Range("a:a"), "c")+ _
Application.CountIf(.Range("c:c"),"c")
ReDim a(1 To x, 1 To 3)
For Each r In .Range("a1", .Range("a65536").End(xlUp))
If r.Value = "a" Or r.Value = "c" or _
r.Offset(,2).value="c" Then
i = i + 1: a(i, 1) = r.Offset(, 5)
a(i, 2) = r.Offset(, 11): a(i, 3) = r.Offset(, 6)
End If
Next
End With
With wbDest.Sheets("Ark1")
..Cells.Clear
..Range("a2").Resize(UBound(a, 1), UBound(a, 2)).Value = a
End With
Erase a
End Sub

Copy from one workbook to another
 

Sub test()
Dim wbBonus As Workbook, wbDest As Workbook
Dim a(), i As Long, r As Range, x
Workbooks.Open Filename:="c:\bonus.xls"
Workbooks.Open Filename:="c:\Destination.xls"
Set wbBonus = Workbooks("bonus.xls")
Set wbDest = Workbooks("Destination.xls")
With wbBonus.Sheets("Ark1")
x = Application.CountIf(.Range("a:-a"), "a") + _
Application.CountIf(.Range("a:-a"), "c") + _
Application.CountIf(.Range("c:c"), "c")
ReDim a(1 To x, 1 To 3)
For Each r In .Range("a1", .Range("a65536").End(xlUp))
If r.Value = "a" Or r.Value = "c" Or _
r.Offset(, 2).Value = "c" Then
i = i + 1: a(i, 1) = r.Offset(, 5)
a(i, 2) = r.Offset(, 11): a(i, 3) = r.Offset(, 6)
End If
Next
End With
With wbDest.Sheets("Ark1")
.Cells.Clear
.Range("a2").Resize(UBound(a, 1), UBound(a, 2)).Value = a
End With
Erase a
End Sub

Copy from one workbook to another
 

Code doesn't work I got this error message:
run time error"1004"
and this get yellow
x = Application.CountIf(.Range("a:-a"), "a") + _
Application.CountIf(.Range("a:-a"), "c") + _
Application.CountIf(.Range("c:c"), "c")

Copy from one workbook to another
 

it is working here

Sub test()
Dim wbBonus As Workbook, wbDest As Workbook
Dim a(), i As Long, r As Range, x
Workbooks.Open Filename:="c:\bonus.xls"
Workbooks.Open Filename:="c:\Destination.xls"
Set wbBonus = Workbooks("bonus.xls")
Set wbDest = Workbooks("Destination.xls")
With wbBonus.Sheets("Ark1")
x = Application.CountIf(.Range("a:a"), "a") + _
Application.CountIf(.Range("a:a"), "c") + _
Application.CountIf(.Range("c:c"), "c")
ReDim a(1 To x, 1 To 3)
For Each r In .Range("a1", .Range("a65536").End(xlUp))
If r.Value = "a" Or r.Value = "c" Or _
r.Offset(, 2).Value = "c" Then
i = i + 1: a(i, 1) = r.Offset(, 5)
a(i, 2) = r.Offset(, 6): a(i, 3) = r.Offset(, 11)
End If
Next
End With
With wbDest.Sheets("Ark1")
.Cells.Clear
.Range("a2").Resize(UBound(a, 1), UBound(a, 2)).Value = a
End With
Erase a
End Sub

Copy from one workbook to another
 

I don't understand why it doesn'(t show my code properly.

Copy from one workbook to another
 

the answer is also in

http://www.excelforum.com/showthread.php?t=359626

check there

Copy from one workbook to another
 

Ok it works thanks very much!!!!!!!