+ Reply to Thread
Results 1 to 11 of 11

Copy from one workbook to another-Workbooks.Open Filename

  1. #1
    Alen32
    Guest

    Copy from one workbook to another-Workbooks.Open Filename

    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").Cells(i, target) = _
    .Cells(i, col).Value
    End If
    Next i
    End With

    End Sub








  2. #2
    Seiya
    Guest

    re: Copy from one workbook to another-Workbooks.Open Filename

    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. #3
    Alen32
    Guest

    re: Copy from one workbook to another-Workbooks.Open Filename

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


  4. #4
    Alen32
    Guest

    re: Copy from one workbook to another-Workbooks.Open Filename

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


  5. #5
    Seiya
    Guest

    re: Copy from one workbook to another-Workbooks.Open Filename

    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. #6
    Seiya
    Guest

    re: Copy from one workbook to another-Workbooks.Open Filename

    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. #7
    Alen32
    Guest

    re: Copy from one workbook to another-Workbooks.Open Filename

    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. #8
    Seiya
    Guest

    re: Copy from one workbook to another-Workbooks.Open Filename

    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. #9
    Seiya
    Guest

    re: Copy from one workbook to another-Workbooks.Open Filename

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


  10. #10
    Seiya
    Guest

    re: Copy from one workbook to another-Workbooks.Open Filename

    the answer is also in

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

    check there


  11. #11
    Alen32
    Guest

    re: Copy from one workbook to another-Workbooks.Open Filename

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


+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1