Want code to copy to ABOVE row 22 column A on sheet 1

  • Thread starter Thread starter Howard
  • Start date Start date
H

Howard

This portion of code works just fine to copy to sheet 1 EXCEPT it sees the permanent data in A22:Z22 and copies very nicely BELOW that data in row 22.

Set nRow = Sheets("Sheet1").Cells(Rows.Count, "A21").End(xlUp)
If nRow.Value = "" Then
Range("A1:Z4").Copy nRow
Range("A1:Z4").ClearContents
ElseIf nRow.Value <> "" Then
Range("A1:Z4").Copy nRow.Offset(3, 0)
Range("A1:Z4").ClearContents
End If


I modified this line, which worked fine on a different sheet, to copy to Sheet1 above row A22. On the other sheet, column AC is 'clean' from top to bottom. Apparently it does not recognize the 21 with the column A and copies below the existing data in A22:Z22.

Set nRow = Cells(Rows.Count, "AC").End(xlUp)

How do I make start from A21 and go up from there on sheet 1?

Thanks,
Howard
 
Hi Howard,

Am Fri, 28 Jun 2013 22:53:17 -0700 (PDT) schrieb Howard:
How do I make start from A21 and go up from there on sheet 1?
Click to expand...

try:

Dim nRow As Integer

With Sheets("Sheet1")
nRow = WorksheetFunction.CountA(.Range("A1:A21"))
Range("A1:Z4").Copy .Cells(21 - (nRow + 3), 1)
Range("A1:Z4").ClearContents
End With


Regards
Claus B.
 
Dim nRow As Integer

With Sheets("Sheet1")

nRow = WorksheetFunction.CountA(.Range("A1:A21"))

Range("A1:Z4").Copy .Cells(21 - (nRow + 3), 1)

Range("A1:Z4").ClearContents

End With
Click to expand...

Hi Claus,

After plugging in the snippet you provided, I see it does what I described.

I was wrong in my description as I can see now. The copy is indeed above the data in A22:Z22, but I need it to go to row 1 and come down from there. And since there will be a number of rows copied to sheet 1, there should be a two row gap between each copied line as it does with you new snippet but start at the top of the sheet and come down.

Thanks for your patience, clearly my bad description. Sorry.

Howard
 
Hi Howard,

Am Sat, 29 Jun 2013 02:19:20 -0700 (PDT) schrieb Howard:
I was wrong in my description as I can see now. The copy is indeed above the data in A22:Z22, but I need it to go to row 1 and come down from there. And since there will be a number of rows copied to sheet 1, there should be a two row gap between each copied line as it does with you new snippet but start at the top of the sheet and come down.
Click to expand...

I don't know if I understood your handling with the gap. Gap after each
copied row or after the bundle of the 4 copied rows?
Now it is always after 4 rows a gap of 2 rows:

Sub test()
Dim nRow As Integer
Dim i As Integer
Dim gap As Integer

With Sheets("Sheet1")
nRow = WorksheetFunction.CountA(.Range("A1:A21"))
If 21 - (nRow + 6) < 4 Then
MsgBox "No more rows"
Exit Sub
End If
If nRow = 0 Then
Range("A1:Z4").Copy .Cells(nRow + 1, 1)
Else
gap = WorksheetFunction.CountBlank(.Range("A1:A" & nRow))
Range("A1:Z4").Copy .Cells(nRow + 3 + gap, 1)
End If
Range("A1:Z4").ClearContents
End With
End Sub


Regards
Claus B.
 
Hi Howard,

Am Sat, 29 Jun 2013 11:51:09 +0200 schrieb Claus Busch:
I don't know if I understood your handling with the gap. Gap after each
copied row or after the bundle of the 4 copied rows?
Now it is always after 4 rows a gap of 2 rows:
Click to expand...

or a little bit shorter:

Sub test2()
Dim nRow As Integer
Dim myTarget As Range

With Sheets("Sheet1")
nRow = .Cells(21, 1).End(xlUp).Row
If 21 - (nRow + 6) < 4 Then
MsgBox "No more rows"
Exit Sub
End If
Set myTarget = IIf(nRow = 1, .Cells(nRow, 1), .Cells(nRow + 3, 1))
Range("A1:Z4").Copy myTarget
Range("A1:Z4").ClearContents
End With
End Sub


Regards
Claus B.
 
Almost there, Claus.

If you don't mind looking at the workbook, here is a link

The copy does fine with 1 line on Crypto Boogie page. Splits it and copiesto row 1 and 3.

If there are two lines then it copies to row 1 and 3, 5 and 7, only a one row gap. More than two lines seems to over write some of the previous copies..

Typically on Crypto Boogie page there will be two to say four or five linesand I would run the split button on all of them at once. Of course there is a limit because the copies can only go down so far on sheet 1 with 21 lines and the two row gaps between each copied line.

https://www.dropbox.com/s/6wft1i45953vyj0/Cryptoquote Drop Box.xlsm

Thanks,
Howard
 
Hi Howard,

Am Sat, 29 Jun 2013 03:51:01 -0700 (PDT) schrieb Howard:

If there are two lines then it copies to row 1 and 3, 5 and 7, only a one row gap. More than two lines seems to over write some of the previous copies.

Typically on Crypto Boogie page there will be two to say four or five lines and I would run the split button on all of them at once. Of course there is a limit because the copies can only go down so far on sheet 1 with 21 lines and the two row gaps between each copied line.

https://www.dropbox.com/s/6wft1i45953vyj0/Cryptoquote Drop Box.xlsm
Click to expand...

I am confused.
Try:
With Sheets("Sheet1")
nRow = .Cells(21, 1).End(xlUp).Row

If 21 - (nRow + 6) < 4 Then
MsgBox "No more rows"
Exit Sub
End If

LRow = Sheets("Crypto Boogie").Cells(Rows.Count, 1).End(xlUp).Row
j = 1
For i = 1 To LRow
If Cells(i, 1) <> "" Then
Range(Cells(i, 1), Cells(i, 26)).Copy .Cells(nRow, 1)
nRow = nRow + 3
End If
Next
Range("A1:Z4").ClearContents
End With


Regards
Claus B.
 
Hi Howard,

I got it ;-)

With Sheets("Sheet1")
nRow = WorksheetFunction.Max(.Cells(21, 1).End(xlUp).Row, _
.Cells(21, 2).End(xlUp).Row)
myC = WorksheetFunction.CountA(.Range(.Cells(nRow, 1), .Cells(nRow,
26)))
Set myTarget = IIf(myC = 0, .Cells(nRow, 1), .Cells(nRow + 3, 1))
If 21 - (nRow + 6) < 4 Then
MsgBox "No more rows"
Exit Sub
End If
Range(Cells(1, 1), Cells(1, 26)).Copy myTarget
Range(Cells(4, 1), Cells(4, 26)).Copy myTarget.Offset(3, 1)
Range("A1:Z4").ClearContents
End With


Regards
Claus B.
 
Hi Howard,

Am Sat, 29 Jun 2013 13:41:54 +0200 schrieb Claus Busch:


try:

With Sheets("Sheet1")
nRow = WorksheetFunction.Max(.Cells(21, 1).End(xlUp).Row, _
.Cells(21, 2).End(xlUp).Row)
Set myTarget = IIf(nRow = 1, .Cells(nRow, 1), .Cells(nRow + 3, 1))

If 21 - (nRow + 6) < 4 Then
MsgBox "No more rows"
Exit Sub
End If

Range(Cells(1, 1), Cells(1, 26)).Copy myTarget
Range(Cells(4, 1), Cells(4, 26)).Copy myTarget.Offset(3, 1)
Range("A1:Z4").ClearContents
End With


Regards
Claus B.
 
Hi again,

Am Sat, 29 Jun 2013 13:46:27 +0200 schrieb Claus Busch:

With Sheets("Sheet1")
nRow = WorksheetFunction.Max(.Cells(21, 1).End(xlUp).Row, _
.Cells(21, 2).End(xlUp).Row)
Set myTarget = IIf(nRow = 1, .Cells(nRow, 1), .Cells(nRow + 3, 1))

If 21 - (nRow + 6) < 4 Then
MsgBox "No more rows"
Exit Sub
End If

Range("A1:Z4").Copy myTarget
Range("A1:Z4").ClearContents
End With


Regards
Claus B.
 
Hi again,



Am Sat, 29 Jun 2013 13:46:27 +0200 schrieb Claus Busch:



With Sheets("Sheet1")

nRow = WorksheetFunction.Max(.Cells(21, 1).End(xlUp).Row, _

.Cells(21, 2).End(xlUp).Row)

Set myTarget = IIf(nRow = 1, .Cells(nRow, 1), .Cells(nRow + 3, 1))



If 21 - (nRow + 6) < 4 Then

MsgBox "No more rows"

Exit Sub

End If



Range("A1:Z4").Copy myTarget

Range("A1:Z4").ClearContents

End With





Regards

Claus B.
Click to expand...
Hi Claus,

This one does the trick. Nice of you to persevere. I can usually get my point across fairly clearly, but I did not do a good job of that here.

It works fine and I thank you.

Regards,
Howard
 
Back
Top