lundi 3 août 2020

How to copy paste data based on some criterias from one workbook to another(specific cells) using VBA?

I have written below code for copying the data from one workbook to specific cells in another workbook (that's challenge I think, destination file has months and relevant data below it, each month I need to copy the data to the current month column, that's why used "last column" function not to overwrite historical months also to make it dynamic to go to the last column where there is no data which current month ). Even though code is working fine I want to optimize it in order debug easily and avoid future problems when for ex; current year changed. Do you have any ideas how can i make this code better?

Code

Dim  x, LastRow, LastColumn, workfile, sourcefile As String
 
 sourcefile = ActiveWorkbook.Name
 workfile = ThisWorkbook.Name


LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1
If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001B" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "GBP" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(28, 21).End(xlToLeft).Column + 1 
    Workbooks(workfile).Worksheets("A").Cells(28, Lastcolumn2).PasteSpecial xlPasteValues
Else

End If

If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001R" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "GBP" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn3 = Workbooks(workfile).Worksheets("A").Cells(29, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(29, Lastcolumn3).PasteSpecial xlPasteValues
Else
End If

If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001B" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "EUR" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn4 = Workbooks(workfile).Worksheets("A").Cells(35, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(35, Lastcolumn4).PasteSpecial xlPasteValues
    Else
    End If
    
If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001R" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "EUR" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn5 = Workbooks(workfile).Worksheets("A").Cells(36, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(36, Lastcolumn5).PasteSpecial xlPasteValues
    Else
    End If
    Next

Aucun commentaire:

Enregistrer un commentaire