VBA ISSUE, COPY AND PASTE, IF function

[Amenolakaky]

Hello all, this my first time to use the VBA and actually i started my first project also i'm a big fan for this community, appreciated
I got a codes from many sites to do the below
1- 'Open method has additional parameters '(This code done)
2-lCopyLastRow2 = wsCopy.Cells(wsCopy.Rows.Count, "D").End(xlUp).Row '(This code done)
3-wsDest.Range("A" & lDestLastRow).PasteSpecial Paste:=xlPasteValues''(This code done)
i succeed to select my data till the last row then open the destination sheet and paste my data.

the issue is !
i need to set if condition after identifying the range & last row = If the new section range "E11:E" & lst row equal "Building/Physical" or "Building/OneClick" then IF MID "D11:D" & LAST ROW equal "3601" then copy and past it in sheet names "SSS" After identifying the last row and past the new data.

else
If the new section range "E11:E" & lst row equal "Building/Physical" or "Building/OneClick" then IF MID "D11:D" & LAST ROW equal "44001" then copy and past it in sheet names "kkk" After identifying the last row and past the new data.
else
If the new section range "E11:E" & lst row equal "Building/Physical" or "Building/OneClick" then IF MID "D11:D" & LAST ROW equal "5500" then copy and past it in sheet names "uuu" After identifying the last row and past the new data.
else
If the new section range "E11:E" & lst row equal "Building/Physical" or "Building/OneClick" then IF MID "D11:D" & LAST ROW equal "6600" then copy and past it in sheet names "uuu" After identifying the last row and past the new data.

If the new section range "E11:E" & lst row equal "Building/Physical" or "Building/OneClick" then IF MID "D11:D" & LAST ROW equal "E360" then copy and past it in sheet names "EEE" After identifying the last row and past the new data.

else
If the new section range "E11:E" & lst row equal "Building/Physical" or "Building/OneClick" then IF MID "D11:D" & LAST ROW equal "E440" then copy and past it in sheet names "TTT" After identifying the last row and past the new data.
...............................................

Please note that every day i open a new sheet with today's name from this source
i have the first code which bring data and paste it in the destination sheet, i just need to set the if as i mentioned above "In the mail sheet or destination sheet" same will be useful.

Many thanks in advance

 

[Amenolakaky]

Many thanks Bro,

the code is working correctly

now i will add
ary2 = Array("36", "44", "55") and the same if that you wrote

and ammend the below to write this data beside the E data.
AutoFilter.Range.Offset(1).Copy Sheets(.Range("A" & lr).Value).Range("A" & Rows.Count).End(3)(2)

many thanks for your efforts dear!!!!!!!!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[Amenolakaky]

Dear

Try this:

Sub Copy_Paste()
  Dim ary1 As Variant, ary2 As Variant
  Dim i As Long, lr As Long
 
  Application.ScreenUpdating = False
  ary1 = Array("E36", "E44", "E55")  'add the others

  With Sheets("mail")
    If .AutoFilterMode Then .AutoFilterMode = False
    .Range("A10").AutoFilter 5, "Building/Physical", xlOr, "Building/OneClick"
    For i = 0 To UBound(ary1)
      .Range("A10").AutoFilter 4, "=" & ary1(i) & "*"
      lr = .Range("A" & Rows.Count).End(3).Row
      If lr > 10 Then
        .AutoFilter.Range.Offset(1).Copy Sheets(.Range("A" & lr).Value).Range("A" & Rows.Count).End(3)(2)
      End If
    Next
    .ShowAllData
  End With
End Sub

Dear Dante,

Kindly is there and way to make this code paste only the values not the formatting or this will lead us to change the previous methods.
" .AutoFilter.Range.Offset(1).Copy Sheets(.Range("A" & lr).Value).Range("A" & Rows.Count).End(3)(2)"
i tried to make it "PasteSpecial xlPasteValues" but it doesnt work.

 

[DanteAmor]

Change this:

.AutoFilter.Range.Offset(1).Copy Sheets(ary2(i)).Range("A" & Rows.Count).End(3)(2)

For this:

        .AutoFilter.Range.Offset(1).Copy
        Sheets(.Range("A" & lr).Value).Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues

 

[Amenolakaky]

Change this:

.AutoFilter.Range.Offset(1).Copy Sheets(ary2(i)).Range("A" & Rows.Count).End(3)(2)

For this:

        .AutoFilter.Range.Offset(1).Copy
        Sheets(.Range("A" & lr).Value).Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues

God bless you, Man

 

[Amenolakaky]

Change this:

.AutoFilter.Range.Offset(1).Copy Sheets(ary2(i)).Range("A" & Rows.Count).End(3)(2)

For this:

        .AutoFilter.Range.Offset(1).Copy
        Sheets(.Range("A" & lr).Value).Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues

the code doesn't accept this part, "PasteSpecial xlPasteValues"
please note that i already ammended it as there are many opened sheets and the code may return nothing so i amended the range like this
" .AutoFilter.Range.Offset(1).Copy Workbooks("Submissiondatabasee.xlsx").Sheets(.Range("A" & lr).Values).Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues"

 

[DanteAmor]

but it goes on another line. check my previous post.

.AutoFilter.Range.Offset(1).Copy

 
Workbooks("Submissiondatabasee.xlsx").Sheets(.Range("A" & lr).Values).Range("A" & Rows.Count).End(3)(2).PasteSpecial