Macro copy cell range sheet to sheet

[ste33uka]

Hi would anyone have a macro that would copy data from
Sheet 1 range C1 to F2000 to next available row on sheet 2 column C
but only if data is entered in the row of to column C
and
Sheet 3 range C1 to F2000 to next available row on sheet 4 column C
but only if data is entered in the row of to column C
So as shown in example, data would stop copying at row 20
Thanks

Book1
	A	B	C	D	E	F	G
1			a1			b7
2			a2			b8
3			a3			b9
4			a4			b10
5			a5			b11
6			a6			b12
7			a7			b13
8			a8			b14
9			a9			b15
10			a10			b16
11			a11			b17
12			a12			b18
13			a13			b19
14			a14			b20
15			a15			b21
16			a16			b22
17			a17			b23
18			a18			b24
19			a19			b25
20						b26
21						b27
22						b28
23						b29
24						b30
25						b31
26						b32
27						b33
28						b34
29						b35
30						b36
Sheet1

 

[ste33uka]

sorry i dont think its possible for what i want, columns c1 to to f40 all have formulas,
But from c20 the formula found nothing so returns blank, thats where i would like it to stop copying,

 

[mehidy1437]

try this,

Sub Paste_NextRow()

    Dim wsCopySh1 As Worksheet
    Dim wsPasteSh2 As Worksheet
    Set wsCopySh1 = Sheets("Sheet1")
    Set wsPasteSh2 = Sheets("Sheet2")
    Dim lastRowSh2 As Long
    lastRowSh2 = ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, 3).End(xlUp).Row + 1
    Dim N As Long
    'N = wsCopySh1.Range("c" & Rows.Count).End(xlUp).Row
    N = wsCopySh1.[match(2,1/(c:c<>""))]
    wsCopySh1.Range("c1:f" & N).Copy
    wsPasteSh2.Range("C" & lastRowSh2).PasteSpecial Paste:=xlPasteValues
    
    '---------------------------------------
    
    Dim wsCopySh3 As Worksheet
    Dim wsPasteSh4 As Worksheet
    Set wsCopySh3 = Sheets("Sheet3")
    Set wsPasteSh4 = Sheets("Sheet4")
    Dim lastRowSh4 As Long
    lastRowSh4 = ThisWorkbook.Sheets("Sheet4").Cells(Rows.Count, 3).End(xlUp).Row + 1
    Dim M As Long
    'M = wsCopySh3.Range("c" & Rows.Count).End(xlUp).Row
    M = wsCopySh3.[match(2,1/(c:c<>""))]
    wsCopySh3.Range("c1:f" & M).Copy
    wsPasteSh4.Range("C" & lastRowSh4).PasteSpecial Paste:=xlPasteValues

End Sub

 

[ste33uka]

try this,

Sub Paste_NextRow()

    Dim wsCopySh1 As Worksheet
    Dim wsPasteSh2 As Worksheet
    Set wsCopySh1 = Sheets("Sheet1")
    Set wsPasteSh2 = Sheets("Sheet2")
    Dim lastRowSh2 As Long
    lastRowSh2 = ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, 3).End(xlUp).Row + 1
    Dim N As Long
    'N = wsCopySh1.Range("c" & Rows.Count).End(xlUp).Row
    N = wsCopySh1.[match(2,1/(c:c<>""))]
    wsCopySh1.Range("c1:f" & N).Copy
    wsPasteSh2.Range("C" & lastRowSh2).PasteSpecial Paste:=xlPasteValues
   
    '---------------------------------------
   
    Dim wsCopySh3 As Worksheet
    Dim wsPasteSh4 As Worksheet
    Set wsCopySh3 = Sheets("Sheet3")
    Set wsPasteSh4 = Sheets("Sheet4")
    Dim lastRowSh4 As Long
    lastRowSh4 = ThisWorkbook.Sheets("Sheet4").Cells(Rows.Count, 3).End(xlUp).Row + 1
    Dim M As Long
    'M = wsCopySh3.Range("c" & Rows.Count).End(xlUp).Row
    M = wsCopySh3.[match(2,1/(c:c<>""))]
    wsCopySh3.Range("c1:f" & M).Copy
    wsPasteSh4.Range("C" & lastRowSh4).PasteSpecial Paste:=xlPasteValues

End Sub

Great stuff, thanks alot ,appreciate it.