Copy, Paste, Vlookup Macro code Needed..

JawaharPrem · Mar 6, 2019

Hi,

i need a vba code for mentioned critra.

1. in master base @ coloum C only "AA" & "AAA" should move sheet named C
2. in master base @ coloum D only "AA" & "AAA" should move sheet named D

After moving i need a vlookup with C & D sheet againts "ALLOC" sheets ref the the coloum names "mapping"if any numbers mapped i need to move the same to calling sheet.

Please help on same and do the needful.

sample file enclosed for ref..

Regards
Jawahar Prem

jayalaxmi · Mar 7, 2019

JawaharPrem said:
Hi,

i need a vba code for mentioned critra.

1. in master base @ coloum C only "AA" & "AAA" should move sheet named C
2. in master base @ coloum D only "AA" & "AAA" should move sheet named D

After moving i need a vlookup with C & D sheet againts "ALLOC" sheets ref the the coloum names "mapping"if any numbers mapped i need to move the same to calling sheet.

Please help on same and do the needful.

sample file enclosed for ref..

Regards
Jawahar Prem

Hi Prem,

Code:

Private Sub CommandButton1_Click()

Sub copy()
'
' copy Macro
'

'
    Range("A1").Select
    Selection.AutoFilter
    Range("C1").Select
    ActiveSheet.Range("$A$1:$O$79").AutoFilter Field:=3, Criteria1:="=AA", _
        Operator:=xlOr, Criteria2:="=AAA"
    Selection.End(xlToLeft).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.copy
    Sheets("C").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Master Base").Select
    Selection.End(xlUp).Select
    Selection.End(xlToLeft).Select
    Range("C1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    Selection.AutoFilter
    Range("D1").Select
    ActiveSheet.Range("$A$1:$O$79").AutoFilter Field:=4, Criteria1:="=A", _
        Operator:=xlOr, Criteria2:="=AA"
    Selection.End(xlToLeft).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.copy
    Sheets("D").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    Sheets("C").Select
    ActiveWindow.SmallScroll Down:=-21
    Sheets("C").Select
End Sub
Sub vlookup()
'
' vlookup Macro
'

'
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'C'!C,1,0)"
    Range("A3").Select
    Selection.End(xlDown).Select
    Range("B22").Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
    ActiveWindow.SmallScroll Down:=-18
    Range("C2").Select
    Selection.AutoFilter
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],D!C[-1],1,0)"
    Range("B3").Select
    Selection.End(xlDown).Select
    Range("C22").Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
    Selection.End(xlUp).Select
    Sheets("ALLOC").Select
    Range("A1").Select
    Selection.AutoFilter
    Range("B1").Select
    Selection.AutoFilter
    ActiveCell.FormulaR1C1 = "col C"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "C"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "D"
    Range("B1").Select
    Selection.AutoFilter
    Range("B1").Select
    ActiveSheet.Range("$A$1:$C$22").AutoFilter Field:=2, Criteria1:=Array( _
        "U0112450099", "U0112450100", "U0112491389", "U0112491390", "U0112516559", _
        "U0118527175", "U0118572053", "U0123079573"), Operator:=xlFilterValues
    Range("B1").Select
    Selection.AutoFilter
    Range("B1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$C$22").AutoFilter Field:=2, Criteria1:="#N/A"
    Range("C1").Select
    ActiveSheet.Range("$A$1:$C$22").AutoFilter Field:=3, Criteria1:="#N/A"
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("A1").Select
    Selection.AutoFilter
    Selection.AutoFilter
    Range("C1").Select
    ActiveSheet.Range("$A$1:$C$22").AutoFilter Field:=3, Criteria1:=Array( _
        "U0112419682", "U0112509564", "U0112724014", "U0112726365", "U0114261397", _
        "U0114728862"), Operator:=xlFilterValues
    Range("B1").Select
    Selection.AutoFilter
    Range("B1").Select
    Selection.AutoFilter
    Range("C1").Select
    ActiveSheet.Range("$A$1:$C$22").AutoFilter Field:=3, Criteria1:="#N/A"
    Range("B1").Select
    ActiveSheet.Range("$A$1:$C$22").AutoFilter Field:=2, Criteria1:="#N/A"
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Rows("2:22").Select
    Range("B2").Activate
    Selection.Delete Shift:=xlUp
    Range("B1").Select
    Selection.AutoFilter
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.copy
    Sheets("Calling").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F14").Select
    Columns("A:A").EntireColumn.AutoFit
End Sub

Try using this code.
I tried attaching the file but the file size seems to be very big and it is not allowing to attach.
I had also included the command button.

Please let me know if it helps you.

Thanks
Jaya

JawaharPrem · Mar 7, 2019

Hi,

thanks for your time,

i have tried this macro by getting some error can u please help on same file enclosed for reference.

Code:

Option Explicit
Sub copyrows()
Dim lRow As Long
Dim lCol As Integer
 
Application.ScreenUpdating = False
  Sheets("Master Base").Select
  lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  lCol = sheet1.Cells(1, sheet1.Columns.Count).End(xlToLeft).Column
  lCol = lCol + 1
 
  Range("A1:O" & lRow).SpecialCells(xlCellTypeVisible).Copy
  Sheets("Calling").Select
  Sheets("Calling").Range("A1").PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  Cells(1, lCol).Value = "Mapping"
 
  Cells(2, lCol).FormulaR1C1 = "=IF(OR(RC[-13]=""AA"",RC[-13]=""AAA"",RC[-12]=""AA"",RC[-12]=""AAA""),1,2)"
  Cells(lRow, lCol).Select
  Range(Selection, Selection.End(xlUp)).Select
  Selection.FillDown
  Range("A1:p" & lRow).Value = Range("A1:p" & lRow).Value
 
  Range("A1").Select
  Selection.AutoFilter
  ActiveWorkbook.Worksheets("Calling").AutoFilter.Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("Calling").AutoFilter.Sort.SortFields.Add Key:= _
  Range("P1:p" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveWorkbook.Worksheets("Calling").AutoFilter.Sort
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
  ActiveSheet.Range("A1:p" & lRow").AutoFilter Field:=16, Criteria1:="2"
 
 
  ActiveCell.Offset(1, 0).Select
  Do Until ActiveCell.entirerow.Hidden = False
  ActiveCell.Offset(1, 0).Select
  Loop
 
  Rows(ActiveCell.Row & ":" & lRow).Delete
  Selection.AutoFilter
  Range("A1").Select
 
  lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
  Cells(2, lCol).Select
  Cells(2, lCol).FormulaR1C1 = "=VLOOKUP(RC[-14],ALLOC!C1,1,0)"
  Range(Selection, Selection.End(xlDown)).Select
  Selection.FillDown
  Range("A1:p" & lRow).Value = Range("A1:p" & lRow).Value
 
  Range("A1").Select
  Selection.AutoFilter
  ActiveWorkbook.Worksheets("Calling").AutoFilter.Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("Calling").AutoFilter.Sort.SortFields.Add Key:= _
  Range("P1:p" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveWorkbook.Worksheets("Calling").AutoFilter.Sort
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
  ActiveSheet.Range("A1:p" & lRow").AutoFilter Field:=16, Criteria1:="#N/A"
 
  ActiveCell.Offset(1, 0).Select
  Do Until ActiveCell.entirerow.Hidden = False
  ActiveCell.Offset(1, 0).Select
  Loop
 
  Rows(ActiveCell.Row & ":" & lRow).Delete
  Selection.AutoFilter
  Range("A1").Select
  Columns(lCol).Delete
 
End Sub

jayalaxmi · Mar 7, 2019

JawaharPrem said:
Hi,

thanks for your time,

i have tried this macro by getting some error can u please help on same file enclosed for reference.

Option Explicit
Sub copyrows()
Dim lRow As Long
Dim lCol As Integer

Application.ScreenUpdating = False
Sheets("Master Base").Select
lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lCol = sheet1.Cells(1, sheet1.Columns.Count).End(xlToLeft).Column
lCol = lCol + 1

Range("A1:O" & lRow).SpecialCells(xlCellTypeVisible).Copy
Sheets("Calling").Select
Sheets("Calling").Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Cells(1, lCol).Value = "Mapping"

Cells(2, lCol).FormulaR1C1 = "=IF(OR(RC[-13]=""AA"",RC[-13]=""AAA"",RC[-12]=""AA"",RC[-12]=""AAA""),1,2)"
Cells(lRow, lCol).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Range("A1" & lRow).Value = Range("A1" & lRow).Value

Range("A1").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("Calling").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Calling").AutoFilter.Sort.SortFields.Add Key:= _
Range("P1" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Calling").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("A1" & lRow").AutoFilter Field:=16, Criteria1:="2"

ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.entirerow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop

Rows(ActiveCell.Row & ":" & lRow).Delete
Selection.AutoFilter
Range("A1").Select

lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Cells(2, lCol).Select
Cells(2, lCol).FormulaR1C1 = "=VLOOKUP(RC[-14],ALLOC!C1,1,0)"
Range(Selection, Selection.End(xlDown)).Select
Selection.FillDown
Range("A1" & lRow).Value = Range("A1" & lRow).Value

Range("A1").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("Calling").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Calling").AutoFilter.Sort.SortFields.Add Key:= _
Range("P1" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Calling").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("A1" & lRow").AutoFilter Field:=16, Criteria1:="#N/A"

ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.entirerow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop

Rows(ActiveCell.Row & ":" & lRow).Delete
Selection.AutoFilter
Range("A1").Select
Columns(lCol).Delete

End Sub

Hi Prem,

Please check out the attached file.

For me its working fine

.Let me know if you still encounter any error.

Thanks
Jaya

Nebu · Mar 7, 2019

Hi:

Use the following code

Code:

Sub blah()

With Sheet1
On Error Resume Next
.ShowAllData
i& = .Cells(Rows.Count, "A").End(xlUp).Row
j& = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row
k& = Sheet4.Cells(Rows.Count, "A").End(xlUp).Row
l& = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
Sheet3.Range("A2:P" & j).ClearContents
Sheet4.Range("A2:P" & k).ClearContents
.Range("$A$1:$O$" & i).AutoFilter Field:=3, Criteria1:="=AA", _
Operator:=xlOr, Criteria2:="=AAA"
.Range("$A$2:$O$" & i).SpecialCells(xlCellTypeVisible).copy
Sheet3.Range("A2").PasteSpecial
.ShowAllData
.Range("$A$1:$O$" & i).AutoFilter Field:=4, Criteria1:="=AA", _
Operator:=xlOr, Criteria2:="=AAA"
.Range("$A$2:$O$" & i).SpecialCells(xlCellTypeVisible).copy
Sheet4.Range("A2").PasteSpecial
End With
With Sheet3
m& = Sheet5.Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("P2") = "=VLOOKUP(B2,ALLOC!A2:A" & i & ",1,0)"
.Range("P2:P" & j).FillDown
.Range("P2:P" & j).Value = .Range("P2:P" & j).Value
.Range("$A$1:$P$" & j).AutoFilter Field:=16, Criteria1:="<>#N/A", Operator:=xlFilterValues
.Range("$A$2:$P$" & j).SpecialCells(xlCellTypeVisible).copy
Sheet5.Range("A" & m).PasteSpecial
End With

With Sheet4
m& = Sheet5.Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("P2") = "=VLOOKUP(B2,ALLOC!A2:A" & i & ",1,0)"
.Range("P2:P" & k).FillDown
.Range("P2:P" & k).Value = .Range("P2:P" & k).Value
.Range("$A$1:$P$" & k).AutoFilter Field:=16, Criteria1:="<>#N/A", Operator:=xlFilterValues
.Range("$A$2:$P$" & k).SpecialCells(xlCellTypeVisible).copy
Sheet5.Range("A" & m).PasteSpecial
End With

End Sub

JawaharPrem · Mar 7, 2019

Hi Nebu & Jaya, Thanks for your time working fine...

Copy, Paste, Vlookup Macro code Needed..

JawaharPrem

Member

Attachments

jayalaxmi

Active Member

JawaharPrem

Member

Attachments

jayalaxmi

Active Member

Attachments

Nebu

Excel Ninja

Attachments

JawaharPrem

Member