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

 

[mehidy1437]

Try below,

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
    wsCopySh1.Range("c1:f" & N).Copy wsPasteSh2.Range("C" & lastRowSh2)
    
    '---------------------------------------
    
    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
    wsCopySh3.Range("c1:f" & M).Copy wsPasteSh4.Range("C" & lastRowSh4)

End Sub

 

[ste33uka]

Try below,

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
    wsCopySh1.Range("c1:f" & N).Copy wsPasteSh2.Range("C" & lastRowSh2)
   
    '---------------------------------------
   
    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
    wsCopySh3.Range("c1:f" & M).Copy wsPasteSh4.Range("C" & lastRowSh4)

End Sub

Thanks that works ,
but i should of said, sum cells are formulas, is it possible to paste the values and not the formulas ?
Thanks

 

[mehidy1437]

This should do the job,

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
    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
    wsCopySh3.Range("c1:f" & M).Copy
    wsPasteSh4.Range("C" & lastRowSh4).PasteSpecial Paste:=xlPasteValues

End Sub

 

[ste33uka]

This should do the job,

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
    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
    wsCopySh3.Range("c1:f" & M).Copy
    wsPasteSh4.Range("C" & lastRowSh4).PasteSpecial Paste:=xlPasteValues

End Sub

Thanks alot, thats exactly what i need

 

[mehidy1437]

You are welcome.

 

[ste33uka]

You are welcome.

Is it possible it would only copy if value is in row of column, so it would ignore a formula ?

 

[mehidy1437]

I'm not getting you correctly, could you please explain a bit more? The last code (post #4) is pasting the values only without any formula, right?

 

[ste33uka]

Sorry i will try to explain better,
Yes i only want to paste values , but macro keeps copying rows if it sees formula in columns C
Example row 20 to 40 column C has formulas, it still copys that them rows , which i dont want it to do
Thank for helping

 

[mehidy1437]

So, you mean column C20-C40 has the formula, but column d-e-f don't have any values for these rows, right?