how could stop copy to the bottom repeatedly after lastrow contains data

[abdo meghari]

Hello
how can I make this code copy data to the bottom after data already existed without repeating copying to the bottom when run the macro more than one time

Sub COPY_RANGE()
Dim lr As Long, lr2 As Long
With Sheets("PURCHASE")
    lr2 = .Range("B" & .Rows.Count).End(xlUp).Row
    .Range("B2:C" & lr2).Copy
End With
With Sheets("Table 1")
    lr = .Range("B" & .Rows.Count).End(xlUp).Row
    .Range("B" & lr + 1).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End With

End Sub

SOURCE DATA

REPORT.xlsm
	A	B	C	D
1	ITEM	BRAND	SL	BU
2	1	BS 1200 R20 18PR G580 THI		32
3	2	BS 1200 R20 18PR G580		596
4	3	BS 1200R20-18PR R187 JAP		19
5	4	BS 1200R24 G580		492
6	5	BS 1200R24 G582		191
7	6	BS 13 R22.5 R187 JAP	8	2
8	7	BS 175/65R14 EP150 THI		4
9	8	BS 185/65R15 B250 JAP		4
10	9	BS 185/70R13 EP150 IND		4
11	10	BS 195/55R16 EP300 THI		2
12	11	BS 195R14C 613 JAP		44
13	12	BS 195R14C R623 THI		20
14	13	BS 195R14C R624 HD 106P104P 8 TURK		12
15	14	BS 195R15C 613V JAP		8
16	15	BS 195R15C R623 THI		4
17	16	BS 205/60R16 T005 THI		4
18	17	BS 205/65R15 EP150 IND		4
19	18	BS 205/70R15C R623 THI		18
20	19	BS 205/70R15C R660 TURK	4	18
21	20	BS 205R16C D840 THI		28
22	21	BS 215/55R17 GR90 IND		2
23	22	BS 215/60R16 ER30 JAP		4
24	23	BS 215/65R16 D688 JAP		4
25	24	BS 215/70R15C R624 HD109S107S 8 TURK		16
26	25	BS 215/70R15C R660 TURK		24
27	26	BS 225/45R18 T005 JAP		4
28	27	BS 225/50R17 EP300 THI		4
29	28	BS 225/55 R16 EP300 IND		8
30	29	BS 225/55R16 T001 JAP		2
31	30	BS 225/60R18 ALENZA1 JAP		4
32	31	BS 225/70R15C R623 JAP		28
33	32	BS 225/70R15C R624 112R110R TURK		116
34	33	BS 225/70R15C R660 112S110S 8 TURK		24
35	34	BS 225/95R16C D619 JAP		6
36	35	BS 235/55R17 ER300 JAP		4
37	36	BS 245/40R17 T001 JAP		4
38	37	BS 245/40R19 T005 JAP		2
39	38	BS 245/70R16 D684 THI		2
40	39	BS 255/70R15C D840 THI		276
41	40	BS 265/70R16 D840 THI		1
42	41	BS 275/65R18 AL01 JAP		4
43	42	BS 285/50R20 D-SPORT JAP		20
44	43	BS 315/80R22.5 R152 JAP		12
45	44	BS 315/80R22.5 R184 JAP	2	2
46	45	BS 315/80R22.5 R184 THI		12
47	46	BS 315/80R22.5-18PR G580 JAP		2
48	47	BS 385/65 R22.5 R164 JAP		2
49	48	BS 385/65 R22.5 R164 THI		6
50	49	BS 650R16 R230 JAP		5
51	50	BS 700R16 12PR R230 JAP		6
52	51	BS 750R16 R230 TCF JAP		224
53	52	Dayton 1200r24 DA53 THI		85
54	53	Dayton 385/65r22.5 DT40 THI		6
55	54	FIRESTONE 215/60R16 ROADHAWK ITALY		4
56	55	FS 275/65R18 116H IND		4
Table 1

REPORT.xlsm
	A	B	C
1	Sr	Description	Quantity
2	1	BS 1200R20 G580 TCF	450
3	2	BS 1200R20 G580	100
4	3	BS 325/95 R24 G582	300
5	4	BS 325/95 R24 M840	30
6	5	BS 1200R24 G580	898
7	6	Dayton 1200R24 DA53 THA	100
8	7	BS 1200R24 G582	95
9	8	BS 650R16 R230	250
10	9	BS 700R16 R230	700
11	10	BS 750R16 R230 TCF	199
12	11	BS 225/60 R18 ALENZA1	100
13	12	BS 195/65 R15 EP150	100
14	13	BS 265/65 R17 D840	240
15	14	BS 205 R14C R624	60
16	15	BS 1200R20 G580 TCF	1,533
17	16	BS 1200R20 G580 THA	100
18	17	BS 1200R20 R187 TCF	34
19	18	BS 750R16 R230 TCF	1,069
20	19	BS 650R16 R230	100
21	20	BS 205R16C D840	100
22	21	BS 225/95 R16C D619	64
23	22	BS 255/70 R15C D840	100
24	23	BS 195/65 R15 T001 91V TL	100
25	24	BS 195/65 R15 EP150	100
26	25	BS 265/65 R17 D840	110
27	26	BS 285/60 R18 D-SPORT JAP	15
28	27	BS 265/60R18 D840	40
29	28	BS 275/65 R18 AL01	40
30	29	BS 225/60 R17 D-SPORT	30
31	30	BS 275/55 R20 ALENZA	16
32	31	BS 1200R20 R187 TCF	100
PURCHASE

result should be when run the macro more than one time

REPORT.xlsm
	A	B	C	D
1	ITEM	BRAND	SL	BU
2	1	BS 1200 R20 18PR G580 THI		32
3	2	BS 1200 R20 18PR G580		596
4	3	BS 1200R20-18PR R187 JAP		19
5	4	BS 1200R24 G580		492
6	5	BS 1200R24 G582		191
7	6	BS 13 R22.5 R187 JAP	8	2
8	7	BS 175/65R14 EP150 THI		4
9	8	BS 185/65R15 B250 JAP		4
10	9	BS 185/70R13 EP150 IND		4
11	10	BS 195/55R16 EP300 THI		2
12	11	BS 195R14C 613 JAP		44
13	12	BS 195R14C R623 THI		20
14	13	BS 195R14C R624 HD 106P104P 8 TURK		12
15	14	BS 195R15C 613V JAP		8
16	15	BS 195R15C R623 THI		4
17	16	BS 205/60R16 T005 THI		4
18	17	BS 205/65R15 EP150 IND		4
19	18	BS 205/70R15C R623 THI		18
20	19	BS 205/70R15C R660 TURK	4	18
21	20	BS 205R16C D840 THI		28
22	21	BS 215/55R17 GR90 IND		2
23	22	BS 215/60R16 ER30 JAP		4
24	23	BS 215/65R16 D688 JAP		4
25	24	BS 215/70R15C R624 HD109S107S 8 TURK		16
26	25	BS 215/70R15C R660 TURK		24
27	26	BS 225/45R18 T005 JAP		4
28	27	BS 225/50R17 EP300 THI		4
29	28	BS 225/55 R16 EP300 IND		8
30	29	BS 225/55R16 T001 JAP		2
31	30	BS 225/60R18 ALENZA1 JAP		4
32	31	BS 225/70R15C R623 JAP		28
33	32	BS 225/70R15C R624 112R110R TURK		116
34	33	BS 225/70R15C R660 112S110S 8 TURK		24
35	34	BS 225/95R16C D619 JAP		6
36	35	BS 235/55R17 ER300 JAP		4
37	36	BS 245/40R17 T001 JAP		4
38	37	BS 245/40R19 T005 JAP		2
39	38	BS 245/70R16 D684 THI		2
40	39	BS 255/70R15C D840 THI		276
41	40	BS 265/70R16 D840 THI		1
42	41	BS 275/65R18 AL01 JAP		4
43	42	BS 285/50R20 D-SPORT JAP		20
44	43	BS 315/80R22.5 R152 JAP		12
45	44	BS 315/80R22.5 R184 JAP	2	2
46	45	BS 315/80R22.5 R184 THI		12
47	46	BS 315/80R22.5-18PR G580 JAP		2
48	47	BS 385/65 R22.5 R164 JAP		2
49	48	BS 385/65 R22.5 R164 THI		6
50	49	BS 650R16 R230 JAP		5
51	50	BS 700R16 12PR R230 JAP		6
52	51	BS 750R16 R230 TCF JAP		224
53	52	Dayton 1200r24 DA53 THI		85
54	53	Dayton 385/65r22.5 DT40 THI		6
55	54	FIRESTONE 215/60R16 ROADHAWK ITALY		4
56	55	FS 275/65R18 116H IND		4
57	56	BS 1200R20 G580 TCF	450
58	57	BS 1200R20 G580	100
59	58	BS 325/95 R24 G582	300
60	59	BS 325/95 R24 M840	30
61	60	BS 1200R24 G580	898
62	61	Dayton 1200R24 DA53 THA	100
63	62	BS 1200R24 G582	95
64	63	BS 650R16 R230	250
65	64	BS 700R16 R230	700
66	65	BS 750R16 R230 TCF	199
67	66	BS 225/60 R18 ALENZA1	100
68	67	BS 195/65 R15 EP150	100
69	68	BS 265/65 R17 D840	240
70	69	BS 205 R14C R624	60
71	70	BS 1200R20 G580 TCF	1533
72	71	BS 1200R20 G580 THA	100
73	72	BS 1200R20 R187 TCF	34
74	73	BS 750R16 R230 TCF	1069
75	74	BS 650R16 R230	100
76	75	BS 205R16C D840	100
77	76	BS 225/95 R16C D619	64
78	77	BS 255/70 R15C D840	100
79	78	BS 195/65 R15 T001 91V TL	100
80	79	BS 195/65 R15 EP150	100
81	80	BS 265/65 R17 D840	110
82	81	BS 285/60 R18 D-SPORT JAP	15
83	82	BS 265/60R18 D840	40
84	83	BS 275/65 R18 AL01	40
85	84	BS 225/60 R17 D-SPORT	30
86	85	BS 275/55 R20 ALENZA	16
87	86	BS 1200R20 R187 TCF	100
88
Table 1

should clear data from row 57 before brings data . should start after last row contains data .

 

[abdo meghari]

thanks but it copys to the bottom repeatedly .

 

[Legacy 143009]

To the same row? It should inrease i.
Ok I will go with the old code:

Sub copyItems()
  Dim lRow1 As Long, lRow2 As Long
  Dim Purchase As Worksheet

  Set Purchase = Worksheets("PURCHASE")
  lRow1 = Worksheets("Table 1").Cells(Rows.Count, 1).End(xlUp).Row
  lRow2 = Purchase.Cells(Rows.Count, 1).End(xlUp).Row
  With Worksheets("Table 1")
    For i = 2 To lRow2
      .Cells(lRow1 + i-1, 1).Value = .Cells(lRow1 + i-2, 1).Value + 1
      .Cells(lRow1 + i-1, 2).Value = Purchase.Cells(i, 2).Value
      .Cells(lRow1 + i-1, 3).Value = Purchase.Cells(i, 3).Value
    Next
  End With
End Sub

 

[abdo meghari]

nothing changes

 

[Legacy 143009]

I am sure you are doing something wrong. This is exactly the same code letter by letter with the first one.
Only changed this line for auto increment: .Cells(lRow1 + i-1, 1).Value = .Cells(lRow1 + i-2, 1).Value + 1

how could stop copy to the bottom repeatedly after lastrow contains data

Hello how can I make this code copy data to the bottom after data already existed without repeating copying to the bottom when run the macro more than one time Sub COPY_RANGE() Dim lr As Long, lr2 As Long With Sheets("PURCHASE") lr2 = .Range("B" &...

www.mrexcel.com

So the first code is not working anymore? You said it was working?

 

[abdo meghari]

ok see the file and you can check yourself
cop.xlsm

 

[Legacy 143009]

It worked on the first click. See your self below. Maybe your screenupdating was left False.
In a seperate sub first run the code below only at once. Then try again.

Sub test()
  Application.ScreenUpdating = True
End Sub

 

[abdo meghari]

what happens if you run the second,third,....?
then should not copy to the bottom again and this is waht happens for me.

 

[Legacy 143009]

It keeps adding. Don't you want it?

 

[HaHoBe]

Hi abdo meghari,

how about

Sub MrE_1224954_161610A()
' https://www.mrexcel.com/board/threads/how-could-stop-copy-to-the-bottom-repeatedly-after-lastrow-contains-data.1224954/
  Dim wsTarg As Worksheet
  Dim wsSource As Worksheet
  Dim lngCounter As Long

  Set wsSource = Worksheets("PURCHASE")
  Set wsTarg = Worksheets("Table 1")
  With wsTarg
    For lngCounter = 2 To wsSource.Cells(Rows.Count, 1).End(xlUp).Row
      If WorksheetFunction.CountIf(.UsedRange.Columns(2), wsSource.Cells(lngCounter, 2).Value) = 0 Then
        With .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
          .Value = .Offset(-1, 0).Value + 1
          .Offset(0, 1).Value = wsSource.Cells(lngCounter, 2).Value
          .Offset(0, 2).Value = wsSource.Cells(lngCounter, 3).Value
        End With
      End If
    Next lngCounter
  End With
 
  Set wsTarg = Nothing
  Set wsSource = Nothing
End Sub

Ciao,
Holger

 

[HaHoBe]

Or limit the range for the check to start in the first row after filled rows in Column A

Sub MrE_1224954_161610A2()
' https://www.mrexcel.com/board/threads/how-could-stop-copy-to-the-bottom-repeatedly-after-lastrow-contains-data.1224954/
  Dim wsTarg As Worksheet
  Dim wsSource As Worksheet
  Dim lngCounter As Long
  Dim rngSearch As Range

  Set wsSource = Worksheets("PURCHASE")
  Set wsTarg = Worksheets("Table 1")
  With wsTarg
    Set rngSearch = .Range("B" & .Cells(Rows.Count, 1).End(xlUp).Row + 1 & ":B" & .Rows.Count)
    For lngCounter = 2 To wsSource.Cells(Rows.Count, 1).End(xlUp).Row
      If WorksheetFunction.CountIf(rngSearch, wsSource.Cells(lngCounter, 2).Value) = 0 Then
        With .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
          .Value = .Offset(-1, 0).Value + 1
          .Offset(0, 1).Value = wsSource.Cells(lngCounter, 2).Value
          .Offset(0, 2).Value = wsSource.Cells(lngCounter, 3).Value
        End With
      End If
    Next lngCounter
  End With
  
  Set rngSearch = Nothing
  Set wsTarg = Nothing
  Set wsSource = Nothing
End Sub

Ciao,
Holger