Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy from one workbook to another
Thanks Seiya your code work well
I need one more condition: column c should be equal number 50. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy from one workbook to another
Thanks Seiya your code work well
I need one more condition: column c should be equal number 50. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
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") |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy from one workbook to another
I don't understand why it doesn'(t show my code properly.
|
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy from one workbook to another
|
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy from one workbook to another
Ok it works thanks very much!!!!!!!
|
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro to copy an image (or picture) from one workbook to a new sheetin another workbook | Excel Worksheet Functions | |||
Excel-how to link source workbook to copy of destination workbook | Excel Worksheet Functions | |||
Copy cells based on conditions in one workbook to another workbook | Excel Discussion (Misc queries) | |||
copy worksheet from closed workbook to active workbook using vba | Excel Worksheet Functions | |||
Copy a range of cells in an unopened workbook and paste it to the current workbook | Excel Programming |