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

 

[DanteAmor]

Hi and welcome to MrExcel.

Check if the following is what you need.

Sub Copy_Paste()
  Dim ary1 As Variant, ary2 As Variant
  Dim i As Long
  
  Application.ScreenUpdating = False
  ary1 = Array("44001", "5500", "6600", "E360", "E440", "E443")
  ary2 = Array("SSS", "KKK", "UUU", "UUU", "EEE", "TTT")

  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)
      If .Range("A" & Rows.Count).End(3).Row > 10 Then
        .AutoFilter.Range.Offset(1).Copy Sheets(ary2(i)).Range("A" & Rows.Count).End(3)(2)
      End If
    Next
    .ShowAllData
  End With
End Sub

 

[Amenolakaky]

SANSADATABASEE.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O			R
1	Bank Name	Date	App#	Policy	Type	RSTN	User	Status	Reason						1			The data pasted here with my previous code I need to copy from here rows If in column E written "Building/Physical", xlOr, "Building/OneClick" policy number columns if the above condition true then if the mid policy number started with 360 then copy and paste it in sheet aler after the last row as agreed policy number columns if the above condition true then if the mid policy number started with E36 then copy and paste it in sheet ALEX in the another range from column M : U policy number columns if the above condition true then if the mid policy number started with 440 then copy and paste it in sheet aler after the last row as agreed policy number columns if the above condition true then if the mid policy number started with E44 then copy and paste it in sheet AK in the another range from column M : U policy number columns if the above condition true then if the mid policy number started with 6600 then copy and paste it in sheet aler after the last row as agreed policy number columns if the above condition true then if the mid policy number started with E66 then copy and paste it in sheet AMO in the another range from column M : U N.B For the above also you can make the code based on the bank nam ecolumn but i'm afraid if the user didn't add it so we will make it look to the left of the policy number if 36 , e36 ETC.....
2	Alex	18/02/2022	0	360120001	F8	ok	k	done
3	Alex	18/02/2022	1	360120002	Building/Physical	ok	l	done
4	Alex	18/02/2022	2	360120003	Building/Physical	ok	m	done
5	Alex	18/02/2022	3	360120004	Building/OneClick	ok	n	done
6	Alex	18/02/2022	4	360120005	Building/Physical	ok	o	done
7	Alex	18/02/2022	5	360120006	Building/OneClick	ok	k	done
8	Alex	18/02/2022	0	360120007	Building/OneClick	ok	l	done
9	AKK	18/02/2022	3.571429	440120001	Building/Physical	ok	m	done
10	AKK	18/02/2022	3.928571	440120002	Building/OneClick	ok	n	done
11	AKK	18/02/2022	4.285714	440120003	Building/OneClick	ok	o	done
12	AKK	18/02/2022	4.642857	440120004	Building/Physical	ok	k	done
13	AKK	18/02/2022	5	440120005	Building/OneClick	ok	l	done
14	AKK	18/02/2022	5.357143	440120006	Building/OneClick	ok	m	done
15	AKK	18/02/2022	5.714286	440120007	Building/Physical	ok	n	done
16	AKK	18/02/2022	6.071429	440120008	Building/OneClick	ok	o	done
17	AKK	18/02/2022	6.428571	440120009	Building/OneClick	ok	k	done
18	Alex	18/02/2022	6.785714	360120005	Building/Physical	ok	l	done
19	Alex	18/02/2022	7.142857	360120006	Building/OneClick	ok	m	done
20	Alex	18/02/2022	7.5	360120007	Building/OneClick	ok	n	done
21	AKK	18/02/2022	7.857143	440120001	Building/Physical	ok	o	done
22	AKK	18/02/2022	8.214286	440120002	Building/OneClick	ok	k	done
23	Alex	18/02/2022	8.571429	360120005	nothing	ok	l	done
24	Alex	18/02/2022	8.928571	360120006	nothing	ok	m	done
25	Alex	18/02/2022	9.285714	360120007	nothing	ok	n	done
26	AKK	18/02/2022	9.642857	440120001	nothing	ok	o	done
27	AKK	18/02/2022	10	440120002	nothing	ok	k	done
28	Alex			E3600001	Building/OneClick	ok	k	done
29	Alex			E3600002	Building/OneClick	ok	k	done
30	Alex			E3600003	Building/OneClick	ok	k	done
31	Alex			E3600004	Building/OneClick	ok	k	done
32	AKK			E4400001	Building/OneClick	ok	k	done
33	AKK			E4400002	Building/OneClick	ok	k	done
34	AKK			E4400003	Building/OneClick	ok	k	done
35	AKK			E4400004	Building/OneClick	ok	k	done
36	AKK			E4400005	Building/OneClick	ok	k	done
37	AKK			E4400006	Building/OneClick	ok	k	done
38	AMO			66000004	Building/OneClick	ok	k	done
39	AMO			66000004	Building/OneClick	ok	k	done
40	AMO			66000004	Building/OneClick	ok	k	done
41	AMO			66000004	Building/OneClick	ok	k	done
42	AMO			66000004	Building/OneClick	ok	k	done
43	AMO			E6600001	Building/OneClick	ok	k	done
44	AMO			E6600002	Building/OneClick	ok	k	done
Sheet1

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
F28:H44	Expression	=$C29="Booked"	text	NO
E2:H2,F3:H27	Expression	=$C3="Booked"	text	NO
B1	Cell Value	duplicates	text	NO

 

[Amenolakaky]

Hi and welcome to MrExcel.

Check if the following is what you need.

Sub Copy_Paste()
  Dim ary1 As Variant, ary2 As Variant
  Dim i As Long
 
  Application.ScreenUpdating = False
  ary1 = Array("44001", "5500", "6600", "E360", "E440", "E443")
  ary2 = Array("SSS", "KKK", "UUU", "UUU", "EEE", "TTT")

  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)
      If .Range("A" & Rows.Count).End(3).Row > 10 Then
        .AutoFilter.Range.Offset(1).Copy Sheets(ary2(i)).Range("A" & Rows.Count).End(3)(2)
      End If
    Next
    .ShowAllData
  End With
End Sub

Dear DanteAmor,
Many thanks for your help,

I have sent the mini sheet with what i need,

vba code look to sheet one and copy data Ppolicy number starts with "360" to alex sheet in the range for "360" then copy data starts with "e36" to alex sheet in the range for "e36"
then do the same as it mentioned in the mini sheet.
much appreciated !!!!!!

 

[DanteAmor]

Now I understand less your requirement.

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.

That is different from this:

I need to copy from here rows If in column E written "Building/Physical", xlOr, "Building/OneClick"
policy number columns if the above condition true then if the mid policy number started with 360 then copy and paste it in sheet aler after the last row as agreed. Do you mean "Alex" sheet?

policy number columns if the above condition true then if the mid policy number started with E36 then copy and paste it in sheet ALEX in the another range from column M : U . This part is new and not clear to me.

You can comment:
Is the sheet name in column A?

 

[Amenolakaky]

sorry for this Everyday i create a new sheet data range from a11 till H
I created a VBA code to take all this range and save it to database " policy number, user, building or what kind, ETC...
There is three kinds of the building should be serialized based on the bank name "ALEX, AKK, ......so i aimed to amend the code to make it send only data related to "alex" in sub sheet alex

with your help
the vba code with if condition after filtering on building and building oneclick will check the left or mid of the policy number then will copy in paste it in its sheet
you got my point

after you finish this, i will add a formula in everyday sheet to look on the database and find the largest or the last policy number which saved before and add one to bring a new policy number bases on the bank name "ALEX, AKK, ......s.

i think the formula is ready now but i couldn't make the code write the data in sheets based on the first digits of the policy number, with your help the job will be done

Now I understand less your requirement.

That is different from this:



You can comment:
Is the sheet name in column A?

 

[DanteAmor]

You did not answer this:

Is the sheet name in column A?

 

[Amenolakaky]

You did not answer t

You did not answer this:

Yes, it is

 

[Amenolakaky]

column A contain the sheets name end every sheet contains the range for policies which start with "36, 44, 55, 66" in columns ABCD , then policies which start with "E36,E44.E55" IN columns i till p ow what you will set.
I appreciate the time that you are giving to me!

 

[DanteAmor]

column A contain the sheets name

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