Cannot get copy to paste to last open row

[alwynb]

Hi

I got it right to copy the same data to certain amount of rows specified in column G but can't seem to get it to copy to the next open row on sheet2 it keeps copying over the same data.
It work before with End(xlUp).Row + 1 but not now.

Sub CountRows()
Dim lastRow As Long
Dim startCell As Range
Dim i As Long
Dim rowCount As Long

' Set the starting cell
Set startCell = Sheets("Sheet1").Range("G1")

' Find the last row in column G
lastRow = Sheets("Sheet1").Cells(Rows.Count, "G").End(xlUp).Row

' Calculate the row count
rowCount = lastRow - startCell.Row + 1

' Display the result
MsgBox "Number of rows: " & rowCount

' Copy the range "A1:A6"
Sheets("Sheet1").Range("A1:A6").Copy


' Start looping through the rows
For i = 1 To rowCount
' Paste the value in each row of a specific column (e.g., column A)

Sheets("Sheet2").Range("A" & i).PasteSpecial Transpose:=True
Next i

Application.CutCopyMode = False ' Clear the clipboard
End Sub

 

[davesexcel]

Looks like you are copying 6 rows but just incrementing by 1 row to paste.

possibly:

with sheets("Sheet2")
.range("A" & .cells(.rows.count,"A").end(xlup).row).pastespecial....ect...
end with

 

[alwynb]

Hi

It copies the amount of cells in column G count of I mark 4 rowa in sheet1 one column G it will copy 4 rows of A1:A6

 

[alwynb]

Mark column A sheet one a to f and in column G 1-4 rowa and if run script 4 rowa wil copy to sheet2

 

[jolivanes]

You can also replace your code with somthing like this.

Sub Maybe_So()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
    sh2.Cells(1, 1).Resize(sh1.Cells(Rows.Count, 7).End(xlUp).Row, 6).Value = Application.Transpose(sh1.Cells(1, 1).Resize(6).Value)
End Sub

 

[jolivanes]

I assume that you have to change this line in Post #6

sh2.Cells(1, 1).Resize(sh1.Cells(Rows.Count, 7).End(xlUp).Row, 6).Value = Application.Transpose(sh1.Cells(1, 1).Resize(6).Value)

to this

sh2.Cells(sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row, 1).Resize(sh1.Cells(Rows.Count, 7).End(xlUp).Row, 6).Value = Application.Transpose(sh1.Cells(1, 1).Resize(6).Value)

 

[alwynb]

I assume that you have to change this line in Post #6

sh2.Cells(1, 1).Resize(sh1.Cells(Rows.Count, 7).End(xlUp).Row, 6).Value = Application.Transpose(sh1.Cells(1, 1).Resize(6).Value)

to this

sh2.Cells(sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row, 1).Resize(sh1.Cells(Rows.Count, 7).End(xlUp).Row, 6).Value = Application.Transpose(sh1.Cells(1, 1).Resize(6).Value)

Why would I want to resize that was not the post question

 

[alwynb]

You can also replace your code with somthing like this.

Sub Maybe_So()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
[QUOTE="jolivanes, post: 6074262, member: 31329"]
]
[/QUOTE]
Why would I want to resize that was not the post question
    sh2.Cells(1, 1).Resize(sh1.Cells(Rows.Count, 7).End(xlUp).Row, 6).Value = Application.Transpose(sh1.Cells(1, 1).Resize(6).Value)
End Sub

 

[alwynb]

Hi want to paste to sheet2 on the next open row

 

[alwynb]

Got this working with offset

Sub CountRows2()
Dim lastRow As Long
Dim startCell As Range
Dim rowCount As Long

' Set the starting cell
Set startCell = Sheets("Sheet1").Range("G1")

' Find the last row in the column
lastRow = Sheets("Sheet1").Cells(Rows.Count, startCell.Column).End(xlUp).Row

' Calculate the row count
rowCount = lastRow - startCell.Row + 1

' Display the result
MsgBox "Number of rows: " & rowCount




rowOffset = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "G").End(xlUp).Row


Sheets("Sheet1").Range("A1:A6" & lastRow).Copy

For i = 1 To rowCount

'Sheets("Sheet2").Range("A" & pasteRow).PasteSpecial Transpose:=True
Sheets("Sheet2").Range("A" & i).Offset(rowOffset, 0).PasteSpecial Transpose:=True

Next i





End Sub