copy multiple cells t

[jolyji]

I am trying to copy data from source WS to destination WS. I would like to know if I can use a loop to achieve the below result to avoid writing a long number of lines as shown below; Can someone help me to achieve this.

Sub Submit()

Dim sh As Worksheet

Dim sh1 As Worksheet

Dim iRow As Long

Set sh = ThisWorkbook.Sheets("Data_Input")

Set sh1 = ThisWorkbook.Sheets("Data_Source")

iRow = [Counta(Data_input!A:A)] + 1

sh.Range("A" & Last_Row + 1).Value = "=IF(B" & Last_Row + 1 & "="""","""",ROW()-1)"

With sh

.Cells(iRow, 2) = sh1.Range("C5").Value
.Cells(iRow, 3) = sh1.Range("C6").Value
.Cells(iRow, 4) = sh1.Range("C7").Value
.Cells(iRow, 5) = sh1.Range("C8").Value
.Cells(iRow, 6) = sh1.Range("C9").Value
.Cells(iRow, 7) = sh1.Range("C10").Value
.Cells(iRow, 8) = sh1.Range("d11").Value
.Cells(iRow, 9) = sh1.Range("G12").Value
.Cells(iRow, 10) = sh1.Range("G13").Value

 

[jolyji]

I got an idea to achieve the same result with the below code and it worked. Thanks

The below code will reduce the number of lines from 10 to 5.

c=4
for i = 2 to 11
c = c+1
Cells(iRow, i) = sh1.Range("C" & c).Value
Next i