• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Vba code help

shinchan

New Member
my files
target1.xlsx
target2.xlsx
macro.xlsm
If column E of target1.xlsx matches with column A of target2.xlsx then copy and paste the column R data of target1.xlsx to target2.xlsx from column C(if column C has data then column D and if column D has then from column E and so on...)
my all files are located in same

i have written a code but it is not working so plz have a look

Code:
Sub Mysub()
 
   Dim wbk1 As Workbook
   Dim wbk2 As Workbook
 
   Application.ScreenUpdating = False
 
   Set wbk1 = Workbooks.Open(ThisWorkbook.Path & "\ap.xls")
   Set wsh1 = wbk1.Worksheets(1)
 
   Set wbk2 = Workbooks.Open(ThisWorkbook.Path & "\PL.xlsx")
   Set wsh2 = wbk2.Worksheets(1)
 
 
   If wsh1.Range("E1").Value = wsh2.Range("A1").Value Then
   If wsh2.Range("C1").Value <> "" Then
   wsh1.Range("E1").Copy wsh2.Range("C1")
 
End If
End If
 
   Application.DisplayAlerts = False
   wbk1.Close SaveChanges:=True
   wbk2.Close SaveChanges:=True
   Application.DisplayAlerts = True
 
   Application.ScreenUpdating = True
 
End Sub
 

Attachments

  • ap.xls
    28 KB · Views: 3
  • PL.xlsx
    8.1 KB · Views: 3
1-First of all your two workbooks must be saved in the Same Folder
2- active workbook is AP.xls
3- run this macro
Code:
Option Explicit
Sub copy_To_SEC_BOOK()
 Dim wbk1 As Workbook, wsh1 As Worksheet
 Dim wbk2 As Workbook, wsh2 As Worksheet
 Set wbk1 = ThisWorkbook: Set wsh1 = wbk1.Worksheets(1)
 
 Set wbk2 = Workbooks.Open(ThisWorkbook.Path & "\PL.xlsx")
 Set wsh2 = wbk2.Worksheets(1)
 
   If wsh1.Range("E1").Value = wsh2.Range("A1").Value Then
   If wsh2.Range("C1").Value <> "" Then
   wsh1.Range("E1").copy wsh2.Range("C1")
 
End If
End If
 
   Application.DisplayAlerts = False
   wbk1.Close SaveChanges:=True
   wbk2.Close SaveChanges:=True
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
 
End Sub
 
Sir the vba is placed in a macro.xlsm and the two files are closed so we have to open the same
active workbook is AP.xls is incorrect only one file is opened macro.xlsm and when i run the code it should be processed
 
No sir my all files are closed vba code is placed in a macro.xlsm and only macro.xlsm is opened
in my vba code i have written the code like that way it was my mistake i am not a perfect code writer so plz recorrect the vba code sir
 
My code is incorrect and thats y ur code also sir i just wanted to say that If a cells in column E of target1.xlsx matches with a cells in column A of target2.xlsx then copy and paste the column R data of target1.xlsx to target2.xlsx from column C(if column C has data then column D and if column D has then from column E and so on...)
 
shinchan
How many different variations do You have?
Your previous thread has many same writings ..
 
Sorry Sir but i tried to edit the same but i was unsuccessful in that sir so i am looking for help and this was the last variation
 
shinchan
There needs to modify those two file-names and ... source column letter Y to R ... hmm?
 

Attachments

  • APtoPL.xlsb
    25.2 KB · Views: 4
Sir see this and that question both are different plus u have added more specification to that code date i dont need in that code and many more specification u have added but it is not required i need a simple code that will do the process additional features are not required sir so plz help
 
shinchan
You can delete parts which You don't need,
but some of those will make sure eg that result is correct.
If You don't matter of correct results
... then You can use Your code
... which don't work - as You've written Yourself.
 
According to this thread title : 'VBA code help' :​
  • as it's a help forum so VBA code help
  • as it's the VBA section so VBA code help
So according to any forum rules the thread title must contain​
'relevant words' - the same 'in the tag Box' - 'This will aid future searches' …​
The reason why I did not open this thread the day you created it - like others - and​
move directly to the next thread with an accurate title.​
According to the initial post you wrote 'my files, target1.xlsx, target2.xlsx, macro.xlsm'​
but these names are not present in the attachment, no time to guess, move to next thread !​
So when you create a thread take your time and be very accurate for the title, the explanation and the attachment.​
As an attachment with a 'before' workbook and an 'after' workbook for the expected result may help a lot to understand any need …​
 
Code:
Sub Main2()
    Dim ws1 As Worksheet, r1 As Range, f1 As Range
    Dim ws2 As Worksheet, r2 As Range, f2 As Range
    Dim p As String, r As Range

    p = ThisWorkbook.Path & "\" 'Path for workbooks to open.
    'ws1 and ws2 workbooks are expected to exist and worksheet index of 1 for each
    Set ws1 = Workbooks.Open(p & "ap.xls").Worksheets(1)
    Set ws2 = Workbooks.Open(p & "PL2.xlsx").Worksheets(1)

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    Set r1 = ws1.Range("E2", ws1.Cells(ws1.Rows.Count, "E").End(xlUp))
    Set r2 = ws2.Range("A2", ws2.Cells(ws2.Rows.Count, "A").End(xlUp))

    For Each f2 In r2
        Set f1 = r1.Find(f2)
        If Not f1 Is Nothing Then
            Set r = ws2.Cells(f2.Row, ws2.Columns.Count).End(xlToLeft).Offset(, 1)
            If r.Column < 3 Then Set r = ws2.Cells(f2.Row, "C")
            r = ws1.Cells(f1.Row, "R")
        End If
    Next f2

    ws2.Parent.Close True
    ws1.Parent.Close False
    Application.ScreenUpdating = True
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    MsgBox "Tasks are done."
End Sub



Problem Solved
Thnx Sir for giving ur Precious time and Great Support to this post
Have a Great Day Sir
 
Back
Top