Copy Paste by vba

0

my files
ap.xls
PL.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...)

vba code will be placed in a macro.xlsm file and ap.xls and pl.xlsx files are closed so we have to open that file

my all files are located in same

Answer
Discuss

Answers

0
Selected Answer

This can be changed to copy/paste but that is less efficient. Main2() returns a jagged fill as requested in discussion.

In a Module, change value of p to your path. 

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

'similar to, https://www.teachexcel.com/talk/3770/vba-code-to-vlookup-and-display-missing-values-in-new-workbook
Sub Main()
    Dim ws1 As Worksheet, r1 As Range, f1 As Range
    Dim ws2 As Worksheet, r2 As Range, f2 As Range
    Dim a, i As Long, p As String

    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 & "PL.xlsx").Worksheets(1)
    
    Application.ScreenUpdating = False

    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))
    
    ReDim a(1 To r2.Count)
    For Each f2 In r2
        i = i + 1
        a(i) = ""
        Set f1 = r1.Find(f2)
        If Not f1 Is Nothing Then a(i) = ws1.Cells(f1.Row, "R")
    Next f2

    If a(1) = "" And UBound(a) = 1 Then GoTo EndSub
    
    i = ws2.UsedRange.Columns.Count + 1
    ws2.Cells(2, i).Resize(UBound(a)).Value = WorksheetFunction.Transpose(a)
    
EndSub:
    ws2.Parent.Close True
    ws1.Parent.Close False
    Application.ScreenUpdating = True
    MsgBox "Tasks are done."
End Sub

Discuss

Discussion

Sir see the file which i have attached Pl2.xlsx which i added recently in this post 
this code works fine but it has a small issue while pasting the data
style36 (rep: 24) Aug 26, '19 at 12:14 am
Thnx Alot Sir for giving ur precious time and Great Support to this post
Have a Great Day Sir
avinash (rep: 10) Aug 26, '19 at 1:23 am
HI avinash.
I notice the selected solution also adds the value toTCS although it is not on the same row  as target1.
If that is what you wanted then that is fine otherwise my solution handles that
k1w1sm (rep: 197) Aug 26, '19 at 4:51 pm
Add to Discussion
0

Hi There 

I have had quick look at your files. 

Can you confirm that ap.xls = target1.xls

Also there are only 2 items in target 1 that meet your criteria. That is  

MARICO M&MFIN

on rows 4 and 5.

and that the value from column R is to be written the next empty cell after column B

What have you tried so far and what is giving you the problem?

K1

Try the attached.

Just press the do it button

Discuss
0

Yes Sir ap.xls= target1.xls

TCS MARICO AND M&MFIN meet our criteria

correct next empty cell after column B (if column C is blank then start pasting data from there if there is data in column C then paste the data in column D and if column D also has data then from E and so on......)

Sir i tried the code but i was unsuccessful my code is useless sir so plz have a look Sir

Discuss


Answer the Question

You must create an account to use the forum. Create an Account or Login