VBA Copy Paste Problem

  • Thread starter Thread starter Richard Slacum
  • Start date Start date
R

Richard Slacum

Complex Help



I wrote and stole some VBA to do the following.



Basically what I'm trying to do is to print only the rows that column "A"
have an "X" in, but it only works up to approximately 37 rows.any more and
it will not copy.

I'm totally confused on this; any help would greatly be appreciated.

Here is the code thanks.

Rich,





Sub List01()

'Copy all rows with column 1 matching value

' of selected cell to next available row



Application.ScreenUpdating = False

Sheets("Master").Select

Range("A1").Select

On Error Resume Next

Dim mrow As Long

mrow = Cells.SpecialCells(xlLastCell).Row

Dim ThisText As String

Dim Str1 As String

Dim Row As Long

ThisText = "X"

For I = 1 To mrow

If Cells(I, 1) = ThisText Then

Str1 = Str1 & "," & I & ":" & I

End If

Next I

Str1 = Mid(Str1, 2, 2000)

Range(Str1).Copy

Sheets("List").Activate

Range("A1").Select

If [A1].Value <> "" Then

Cells(1, 2).End(xlDown).Select

Row = ActiveCell.Row

Range(Cells(Row + 1, 1), Cells(Row + 1, 1)).Select

End If

ActiveSheet.Paste

Sheets("Master").Activate

Application.ScreenUpdating = False

Application.CutCopyMode = False

Call Print01

End Sub
 
It may be becasue of upper and lowercase X?

Why not use the auto filter and select on the X.
 
Are the cells in column A blank if they don't contain an X.

Sub List01()
Dim rng as Range, rng1 as Range
Worksheets("Master").Activate
On Error Resume Next
set rng = Columns(1).Specialcells(xlconstants,xlTextValues)
On Error goto 0
if rng is nothing then
msgbox "No X's in column A")
exit sub
End if
set rng1 = Worksheets("List").Cells(rows.count,1).End(xlup)
if not isempty(rng1) then set rng1 = rng1.offset(1,0)
rng.entireRow.copy Destination:=rng1
Print01
End Sub
 
Yes the cells are blank.



Tom Ogilvy said:
Are the cells in column A blank if they don't contain an X.

Sub List01()
Dim rng as Range, rng1 as Range
Worksheets("Master").Activate
On Error Resume Next
set rng = Columns(1).Specialcells(xlconstants,xlTextValues)
On Error goto 0
if rng is nothing then
msgbox "No X's in column A")
exit sub
End if
set rng1 = Worksheets("List").Cells(rows.count,1).End(xlup)
if not isempty(rng1) then set rng1 = rng1.offset(1,0)
rng.entireRow.copy Destination:=rng1
Print01
End Sub

--
Regards,
Tom Ogilvy



Richard Slacum said:
Complex Help



I wrote and stole some VBA to do the following.



Basically what I'm trying to do is to print only the rows that column "A"
have an "X" in, but it only works up to approximately 37 rows.any more
and
it will not copy.

I'm totally confused on this; any help would greatly be appreciated.

Here is the code thanks.

Rich,





Sub List01()

'Copy all rows with column 1 matching value

' of selected cell to next available row



Application.ScreenUpdating = False

Sheets("Master").Select

Range("A1").Select

On Error Resume Next

Dim mrow As Long

mrow = Cells.SpecialCells(xlLastCell).Row

Dim ThisText As String

Dim Str1 As String

Dim Row As Long

ThisText = "X"

For I = 1 To mrow

If Cells(I, 1) = ThisText Then

Str1 = Str1 & "," & I & ":" & I

End If

Next I

Str1 = Mid(Str1, 2, 2000)

Range(Str1).Copy

Sheets("List").Activate

Range("A1").Select

If [A1].Value <> "" Then

Cells(1, 2).End(xlDown).Select

Row = ActiveCell.Row

Range(Cells(Row + 1, 1), Cells(Row + 1, 1)).Select

End If

ActiveSheet.Paste

Sheets("Master").Activate

Application.ScreenUpdating = False

Application.CutCopyMode = False

Call Print01

End Sub
Click to expand...
Click to expand...
 
Tom, that worked great thanks...I still don't understand why my code stopped
working at row 37?



Tom Ogilvy said:
Are the cells in column A blank if they don't contain an X.

Sub List01()
Dim rng as Range, rng1 as Range
Worksheets("Master").Activate
On Error Resume Next
set rng = Columns(1).Specialcells(xlconstants,xlTextValues)
On Error goto 0
if rng is nothing then
msgbox "No X's in column A")
exit sub
End if
set rng1 = Worksheets("List").Cells(rows.count,1).End(xlup)
if not isempty(rng1) then set rng1 = rng1.offset(1,0)
rng.entireRow.copy Destination:=rng1
Print01
End Sub

--
Regards,
Tom Ogilvy



Richard Slacum said:
Complex Help



I wrote and stole some VBA to do the following.



Basically what I'm trying to do is to print only the rows that column "A"
have an "X" in, but it only works up to approximately 37 rows.any more
and
it will not copy.

I'm totally confused on this; any help would greatly be appreciated.

Here is the code thanks.

Rich,





Sub List01()

'Copy all rows with column 1 matching value

' of selected cell to next available row



Application.ScreenUpdating = False

Sheets("Master").Select

Range("A1").Select

On Error Resume Next

Dim mrow As Long

mrow = Cells.SpecialCells(xlLastCell).Row

Dim ThisText As String

Dim Str1 As String

Dim Row As Long

ThisText = "X"

For I = 1 To mrow

If Cells(I, 1) = ThisText Then

Str1 = Str1 & "," & I & ":" & I

End If

Next I

Str1 = Mid(Str1, 2, 2000)

Range(Str1).Copy

Sheets("List").Activate

Range("A1").Select

If [A1].Value <> "" Then

Cells(1, 2).End(xlDown).Select

Row = ActiveCell.Row

Range(Cells(Row + 1, 1), Cells(Row + 1, 1)).Select

End If

ActiveSheet.Paste

Sheets("Master").Activate

Application.ScreenUpdating = False

Application.CutCopyMode = False

Call Print01

End Sub
Click to expand...
Click to expand...
 
I would assume because you are building a string and after a certain length,
the string gets too long to use as an argument to Range.


--
Regards,
Tom Ogilvy

Richard Slacum said:
Tom, that worked great thanks...I still don't understand why my code stopped
working at row 37?



Tom Ogilvy said:
Are the cells in column A blank if they don't contain an X.

Sub List01()
Dim rng as Range, rng1 as Range
Worksheets("Master").Activate
On Error Resume Next
set rng = Columns(1).Specialcells(xlconstants,xlTextValues)
On Error goto 0
if rng is nothing then
msgbox "No X's in column A")
exit sub
End if
set rng1 = Worksheets("List").Cells(rows.count,1).End(xlup)
if not isempty(rng1) then set rng1 = rng1.offset(1,0)
rng.entireRow.copy Destination:=rng1
Print01
End Sub

--
Regards,
Tom Ogilvy



Richard Slacum said:
Complex Help



I wrote and stole some VBA to do the following.



Basically what I'm trying to do is to print only the rows that column "A"
have an "X" in, but it only works up to approximately 37 rows.any more
and
it will not copy.

I'm totally confused on this; any help would greatly be appreciated.

Here is the code thanks.

Rich,





Sub List01()

'Copy all rows with column 1 matching value

' of selected cell to next available row



Application.ScreenUpdating = False

Sheets("Master").Select

Range("A1").Select

On Error Resume Next

Dim mrow As Long

mrow = Cells.SpecialCells(xlLastCell).Row

Dim ThisText As String

Dim Str1 As String

Dim Row As Long

ThisText = "X"

For I = 1 To mrow

If Cells(I, 1) = ThisText Then

Str1 = Str1 & "," & I & ":" & I

End If

Next I

Str1 = Mid(Str1, 2, 2000)

Range(Str1).Copy

Sheets("List").Activate

Range("A1").Select

If [A1].Value <> "" Then

Cells(1, 2).End(xlDown).Select

Row = ActiveCell.Row

Range(Cells(Row + 1, 1), Cells(Row + 1, 1)).Select

End If

ActiveSheet.Paste

Sheets("Master").Activate

Application.ScreenUpdating = False

Application.CutCopyMode = False

Call Print01

End Sub
Click to expand...
Click to expand...
Click to expand...
 
Back
Top