Thread: Adding sheets and copying data problem

I'm trying to use this code to add new sheets to a workbook and copy
information from sheet 1 "All Records" to sheet titled "GESA CC" based on
"4-$" in Col A and "GESA CC" in Col B.

The issues I"m having is for some reason only 3 page are being created then
a generic Sheet 4? Not at all sure why that is happening. Then the sort,
copy and paste is not working. Any help you can provide is certainly
appreciated. Thank you.



Sub AllRecordsSortMacros()

Call AddSheets
Call CopyData


End Sub
Sub AddSheets()

Dim NewSheets As Variant
Dim i As Long

NewSheets = Array("Confirm", "GESV CC", "GESA CC", "GESA CC", "All
Matches", "All No Matches")
For i = UBound(NewSheets) To LBound(NewSheets) Step -1
Sheets.Add after:=Sheets(1)
ActiveSheet.Name = NewSheets(i)
Next i

End Sub

Sub CopyData()
Dim rng As Range, cell As Range
Dim i As Long, sh As Worksheet
With Worksheets("All Records")
Set rng = .Range(.Cells(1, 1), _
.Cells(Rows.Count, 1).End(xlUp))
End With
i = 1
Set sh = Worksheets("All Records")
For Each cell In rng
If UCase(Trim(cell.Value)) = "4-$" And _
UCase(Trim(cell.Offset( _
0, 1).Value)) = "GESA CC" Then
cell.EntireRow.Copy sh.Cells(i, 1)
i = i + 1
End If
Next
End Sub

the problem is that you have duplicate names in your array. So it create the
4th sheet, but can't rename it and it dies at that point.

Sub AllRecordsSortMacros()

Call AddSheets
Call CopyData


End Sub
Sub AddSheets()

Dim NewSheets As Variant
Dim i As Long

' change here:

NewSheets = Array("Confirm", "GESV CC", "GESA CC", "XXXX CC", "All
Matches", "All No Matches")
For i = UBound(NewSheets) To LBound(NewSheets) Step -1
Sheets.Add after:=Sheets(1)
ActiveSheet.Name = NewSheets(i)
Next i

End Sub

Sub CopyData()
Dim rng As Range, cell As Range
Dim i As Long, sh As Worksheet
With Worksheets("All Records")
Set rng = .Range(.Cells(1, 1), _
.Cells(Rows.Count, 1).End(xlUp))
End With
i = 1

' change here:

Set sh = Worksheets("GESA CC")
For Each cell In rng
If UCase(Trim(cell.Value)) = "4-$" And _
UCase(Trim(cell.Offset( _
0, 1).Value)) = "GESA CC" Then
cell.EntireRow.Copy sh.Cells(i, 1)
i = i + 1
End If
Next
End Sub

--
Regrds,
Tom Ogilvy

"SITCFanTN" wrote:

> I'm trying to use this code to add new sheets to a workbook and copy
> information from sheet 1 "All Records" to sheet titled "GESA CC" based on
> "4-$" in Col A and "GESA CC" in Col B.
>
> The issues I"m having is for some reason only 3 page are being created then
> a generic Sheet 4? Not at all sure why that is happening. Then the sort,
> copy and paste is not working. Any help you can provide is certainly
> appreciated. Thank you.
>
>
>
> Sub AllRecordsSortMacros()
>
> Call AddSheets
> Call CopyData
>
>
> End Sub
> Sub AddSheets()
>
> Dim NewSheets As Variant
> Dim i As Long
>
> NewSheets = Array("Confirm", "GESV CC", "GESA CC", "GESA CC", "All
> Matches", "All No Matches")
> For i = UBound(NewSheets) To LBound(NewSheets) Step -1
> Sheets.Add after:=Sheets(1)
> ActiveSheet.Name = NewSheets(i)
> Next i
>
> End Sub
>
> Sub CopyData()
> Dim rng As Range, cell As Range
> Dim i As Long, sh As Worksheet
> With Worksheets("All Records")
> Set rng = .Range(.Cells(1, 1), _
> .Cells(Rows.Count, 1).End(xlUp))
> End With
> i = 1
> Set sh = Worksheets("All Records")
> For Each cell In rng
> If UCase(Trim(cell.Value)) = "4-$" And _
> UCase(Trim(cell.Offset( _
> 0, 1).Value)) = "GESA CC" Then
> cell.EntireRow.Copy sh.Cells(i, 1)
> i = i + 1
> End If
> Next
> End Sub
>

Thanks, that makes a world of sense to me. Now my sheets are being added
properly, but the copy and paste isn't taking place. The actual text is col B
of the copy from sheet is "Gesa CC" so I have that in quotes. The error I'm
getting is 1004 Applicatoin-defined or object definred error. I read about it
but truly don't undersand what it is trying to tell me. Do you have an
insight into this run time error code?

here is the new code that I'm using:

Call AddSheets
Call CopyData


End Sub
Sub AddSheets()

Dim NewSheets As Variant
Dim i As Long

NewSheets = Array("Confirm", "GESVCard", "GESACard", "GESACheck", "All
Matches", "All No Matches")
For i = UBound(NewSheets) To LBound(NewSheets) Step -1
Sheets.Add after:=Sheets(1)
ActiveSheet.Name = NewSheets(i)
Next i

End Sub

Sub CopyData()
Dim rng As Range, cell As Range
Dim i As Long, sh As Worksheet
With Worksheets("All Records")
Set rng = .Range(.Cells(1, 1), _
.Cells(Rows.Count, 1).End(xlUp))
End With
i = 1

Set sh = Worksheets("GESACard")
For Each cell In rng
If UCase(Trim(cell.Value)) = "4-$" And _
UCase(Trim(cell.Offset( _
0, 1).Value)) = "Gesa CC" Then
cell.EntireRow.Copy sh.Cells(i, 1)
i = i + 1
End If
Next
End Sub

"Tom Ogilvy" wrote:

> the problem is that you have duplicate names in your array. So it create the
> 4th sheet, but can't rename it and it dies at that point.
>
> Sub AllRecordsSortMacros()
>
> Call AddSheets
> Call CopyData
>
>
> End Sub
> Sub AddSheets()
>
> Dim NewSheets As Variant
> Dim i As Long
>
> ' change here:
>
> NewSheets = Array("Confirm", "GESV CC", "GESA CC", "XXXX CC", "All
> Matches", "All No Matches")
> For i = UBound(NewSheets) To LBound(NewSheets) Step -1
> Sheets.Add after:=Sheets(1)
> ActiveSheet.Name = NewSheets(i)
> Next i
>
> End Sub
>
> Sub CopyData()
> Dim rng As Range, cell As Range
> Dim i As Long, sh As Worksheet
> With Worksheets("All Records")
> Set rng = .Range(.Cells(1, 1), _
> .Cells(Rows.Count, 1).End(xlUp))
> End With
> i = 1
>
> ' change here:
>
> Set sh = Worksheets("GESA CC")
> For Each cell In rng
> If UCase(Trim(cell.Value)) = "4-$" And _
> UCase(Trim(cell.Offset( _
> 0, 1).Value)) = "GESA CC" Then
> cell.EntireRow.Copy sh.Cells(i, 1)
> i = i + 1
> End If
> Next
> End Sub
>
> --
> Regrds,
> Tom Ogilvy
>
> "SITCFanTN" wrote:
>
> > I'm trying to use this code to add new sheets to a workbook and copy
> > information from sheet 1 "All Records" to sheet titled "GESA CC" based on
> > "4-$" in Col A and "GESA CC" in Col B.
> >
> > The issues I"m having is for some reason only 3 page are being created then
> > a generic Sheet 4? Not at all sure why that is happening. Then the sort,
> > copy and paste is not working. Any help you can provide is certainly
> > appreciated. Thank you.
> >
> >
> >
> > Sub AllRecordsSortMacros()
> >
> > Call AddSheets
> > Call CopyData
> >
> >
> > End Sub
> > Sub AddSheets()
> >
> > Dim NewSheets As Variant
> > Dim i As Long
> >
> > NewSheets = Array("Confirm", "GESV CC", "GESA CC", "GESA CC", "All
> > Matches", "All No Matches")
> > For i = UBound(NewSheets) To LBound(NewSheets) Step -1
> > Sheets.Add after:=Sheets(1)
> > ActiveSheet.Name = NewSheets(i)
> > Next i
> >
> > End Sub
> >
> > Sub CopyData()
> > Dim rng As Range, cell As Range
> > Dim i As Long, sh As Worksheet
> > With Worksheets("All Records")
> > Set rng = .Range(.Cells(1, 1), _
> > .Cells(Rows.Count, 1).End(xlUp))
> > End With
> > i = 1
> > Set sh = Worksheets("All Records")
> > For Each cell In rng
> > If UCase(Trim(cell.Value)) = "4-$" And _
> > UCase(Trim(cell.Offset( _
> > 0, 1).Value)) = "GESA CC" Then
> > cell.EntireRow.Copy sh.Cells(i, 1)
> > i = i + 1
> > End If
> > Next
> > End Sub
> >

what line is highlighted when you get that error?

recall that before I posted that code, it had run successfully for me
(albeit with Book1, Tapes, RED and BLUE instead of VISACard err GESACard etc.
)

in addition, this needs to be corrected:

If UCase(Trim(cell.Value)) = "4-$" And _
UCase(Trim(cell.Offset( _
0, 1).Value)) = "Gesa CC" Then

should be

If UCase(Trim(cell.Value)) = "4-$" And _
UCase(Trim(cell.Offset( _
0, 1).Value)) = "GESA CC" Then

since the Ucase command takes the value in cell and makes it all uppercase
for the comparison.

--
Regards,
Tom Ogilvy




"SITCFanTN" wrote:

> Thanks, that makes a world of sense to me. Now my sheets are being added
> properly, but the copy and paste isn't taking place. The actual text is col B
> of the copy from sheet is "Gesa CC" so I have that in quotes. The error I'm
> getting is 1004 Applicatoin-defined or object definred error. I read about it
> but truly don't undersand what it is trying to tell me. Do you have an
> insight into this run time error code?
>
> here is the new code that I'm using:
>
> Call AddSheets
> Call CopyData
>
>
> End Sub
> Sub AddSheets()
>
> Dim NewSheets As Variant
> Dim i As Long
>
> NewSheets = Array("Confirm", "GESVCard", "GESACard", "GESACheck", "All
> Matches", "All No Matches")
> For i = UBound(NewSheets) To LBound(NewSheets) Step -1
> Sheets.Add after:=Sheets(1)
> ActiveSheet.Name = NewSheets(i)
> Next i
>
> End Sub
>
> Sub CopyData()
> Dim rng As Range, cell As Range
> Dim i As Long, sh As Worksheet
> With Worksheets("All Records")
> Set rng = .Range(.Cells(1, 1), _
> .Cells(Rows.Count, 1).End(xlUp))
> End With
> i = 1
>
> Set sh = Worksheets("GESACard")
> For Each cell In rng
> If UCase(Trim(cell.Value)) = "4-$" And _
> UCase(Trim(cell.Offset( _
> 0, 1).Value)) = "Gesa CC" Then
> cell.EntireRow.Copy sh.Cells(i, 1)
> i = i + 1
> End If
> Next
> End Sub
>
> "Tom Ogilvy" wrote:
>
> > the problem is that you have duplicate names in your array. So it create the
> > 4th sheet, but can't rename it and it dies at that point.
> >
> > Sub AllRecordsSortMacros()
> >
> > Call AddSheets
> > Call CopyData
> >
> >
> > End Sub
> > Sub AddSheets()
> >
> > Dim NewSheets As Variant
> > Dim i As Long
> >
> > ' change here:
> >
> > NewSheets = Array("Confirm", "GESV CC", "GESA CC", "XXXX CC", "All
> > Matches", "All No Matches")
> > For i = UBound(NewSheets) To LBound(NewSheets) Step -1
> > Sheets.Add after:=Sheets(1)
> > ActiveSheet.Name = NewSheets(i)
> > Next i
> >
> > End Sub
> >
> > Sub CopyData()
> > Dim rng As Range, cell As Range
> > Dim i As Long, sh As Worksheet
> > With Worksheets("All Records")
> > Set rng = .Range(.Cells(1, 1), _
> > .Cells(Rows.Count, 1).End(xlUp))
> > End With
> > i = 1
> >
> > ' change here:
> >
> > Set sh = Worksheets("GESA CC")
> > For Each cell In rng
> > If UCase(Trim(cell.Value)) = "4-$" And _
> > UCase(Trim(cell.Offset( _
> > 0, 1).Value)) = "GESA CC" Then
> > cell.EntireRow.Copy sh.Cells(i, 1)
> > i = i + 1
> > End If
> > Next
> > End Sub
> >
> > --
> > Regrds,
> > Tom Ogilvy
> >
> > "SITCFanTN" wrote:
> >
> > > I'm trying to use this code to add new sheets to a workbook and copy
> > > information from sheet 1 "All Records" to sheet titled "GESA CC" based on
> > > "4-$" in Col A and "GESA CC" in Col B.
> > >
> > > The issues I"m having is for some reason only 3 page are being created then
> > > a generic Sheet 4? Not at all sure why that is happening. Then the sort,
> > > copy and paste is not working. Any help you can provide is certainly
> > > appreciated. Thank you.
> > >
> > >
> > >
> > > Sub AllRecordsSortMacros()
> > >
> > > Call AddSheets
> > > Call CopyData
> > >
> > >
> > > End Sub
> > > Sub AddSheets()
> > >
> > > Dim NewSheets As Variant
> > > Dim i As Long
> > >
> > > NewSheets = Array("Confirm", "GESV CC", "GESA CC", "GESA CC", "All
> > > Matches", "All No Matches")
> > > For i = UBound(NewSheets) To LBound(NewSheets) Step -1
> > > Sheets.Add after:=Sheets(1)
> > > ActiveSheet.Name = NewSheets(i)
> > > Next i
> > >
> > > End Sub
> > >
> > > Sub CopyData()
> > > Dim rng As Range, cell As Range
> > > Dim i As Long, sh As Worksheet
> > > With Worksheets("All Records")
> > > Set rng = .Range(.Cells(1, 1), _
> > > .Cells(Rows.Count, 1).End(xlUp))
> > > End With
> > > i = 1
> > > Set sh = Worksheets("All Records")
> > > For Each cell In rng
> > > If UCase(Trim(cell.Value)) = "4-$" And _
> > > UCase(Trim(cell.Offset( _
> > > 0, 1).Value)) = "GESA CC" Then
> > > cell.EntireRow.Copy sh.Cells(i, 1)
> > > i = i + 1
> > > End If
> > > Next
> > > End Sub
> > >

Ok, I thought since the text was in the All Records sheet in lower case, I
had to have it in lower case in the code. So even though the text is in
quotes, it still doesn't matter. I understand now, thanks for clarifying
that for m.

"Tom Ogilvy" wrote:

> what line is highlighted when you get that error?
>
> recall that before I posted that code, it had run successfully for me
> (albeit with Book1, Tapes, RED and BLUE instead of VISACard err GESACard etc.
> )
>
> in addition, this needs to be corrected:
>
> If UCase(Trim(cell.Value)) = "4-$" And _
> UCase(Trim(cell.Offset( _
> 0, 1).Value)) = "Gesa CC" Then
>
> should be
>
> If UCase(Trim(cell.Value)) = "4-$" And _
> UCase(Trim(cell.Offset( _
> 0, 1).Value)) = "GESA CC" Then
>
> since the Ucase command takes the value in cell and makes it all uppercase
> for the comparison.
>
> --
> Regards,
> Tom Ogilvy
>
>
>
>
> "SITCFanTN" wrote:
>
> > Thanks, that makes a world of sense to me. Now my sheets are being added
> > properly, but the copy and paste isn't taking place. The actual text is col B
> > of the copy from sheet is "Gesa CC" so I have that in quotes. The error I'm
> > getting is 1004 Applicatoin-defined or object definred error. I read about it
> > but truly don't undersand what it is trying to tell me. Do you have an
> > insight into this run time error code?
> >
> > here is the new code that I'm using:
> >
> > Call AddSheets
> > Call CopyData
> >
> >
> > End Sub
> > Sub AddSheets()
> >
> > Dim NewSheets As Variant
> > Dim i As Long
> >
> > NewSheets = Array("Confirm", "GESVCard", "GESACard", "GESACheck", "All
> > Matches", "All No Matches")
> > For i = UBound(NewSheets) To LBound(NewSheets) Step -1
> > Sheets.Add after:=Sheets(1)
> > ActiveSheet.Name = NewSheets(i)
> > Next i
> >
> > End Sub
> >
> > Sub CopyData()
> > Dim rng As Range, cell As Range
> > Dim i As Long, sh As Worksheet
> > With Worksheets("All Records")
> > Set rng = .Range(.Cells(1, 1), _
> > .Cells(Rows.Count, 1).End(xlUp))
> > End With
> > i = 1
> >
> > Set sh = Worksheets("GESACard")
> > For Each cell In rng
> > If UCase(Trim(cell.Value)) = "4-$" And _
> > UCase(Trim(cell.Offset( _
> > 0, 1).Value)) = "Gesa CC" Then
> > cell.EntireRow.Copy sh.Cells(i, 1)
> > i = i + 1
> > End If
> > Next
> > End Sub
> >
> > "Tom Ogilvy" wrote:
> >
> > > the problem is that you have duplicate names in your array. So it create the
> > > 4th sheet, but can't rename it and it dies at that point.
> > >
> > > Sub AllRecordsSortMacros()
> > >
> > > Call AddSheets
> > > Call CopyData
> > >
> > >
> > > End Sub
> > > Sub AddSheets()
> > >
> > > Dim NewSheets As Variant
> > > Dim i As Long
> > >
> > > ' change here:
> > >
> > > NewSheets = Array("Confirm", "GESV CC", "GESA CC", "XXXX CC", "All
> > > Matches", "All No Matches")
> > > For i = UBound(NewSheets) To LBound(NewSheets) Step -1
> > > Sheets.Add after:=Sheets(1)
> > > ActiveSheet.Name = NewSheets(i)
> > > Next i
> > >
> > > End Sub
> > >
> > > Sub CopyData()
> > > Dim rng As Range, cell As Range
> > > Dim i As Long, sh As Worksheet
> > > With Worksheets("All Records")
> > > Set rng = .Range(.Cells(1, 1), _
> > > .Cells(Rows.Count, 1).End(xlUp))
> > > End With
> > > i = 1
> > >
> > > ' change here:
> > >
> > > Set sh = Worksheets("GESA CC")
> > > For Each cell In rng
> > > If UCase(Trim(cell.Value)) = "4-$" And _
> > > UCase(Trim(cell.Offset( _
> > > 0, 1).Value)) = "GESA CC" Then
> > > cell.EntireRow.Copy sh.Cells(i, 1)
> > > i = i + 1
> > > End If
> > > Next
> > > End Sub
> > >
> > > --
> > > Regrds,
> > > Tom Ogilvy
> > >
> > > "SITCFanTN" wrote:
> > >
> > > > I'm trying to use this code to add new sheets to a workbook and copy
> > > > information from sheet 1 "All Records" to sheet titled "GESA CC" based on
> > > > "4-$" in Col A and "GESA CC" in Col B.
> > > >
> > > > The issues I"m having is for some reason only 3 page are being created then
> > > > a generic Sheet 4? Not at all sure why that is happening. Then the sort,
> > > > copy and paste is not working. Any help you can provide is certainly
> > > > appreciated. Thank you.
> > > >
> > > >
> > > >
> > > > Sub AllRecordsSortMacros()
> > > >
> > > > Call AddSheets
> > > > Call CopyData
> > > >
> > > >
> > > > End Sub
> > > > Sub AddSheets()
> > > >
> > > > Dim NewSheets As Variant
> > > > Dim i As Long
> > > >
> > > > NewSheets = Array("Confirm", "GESV CC", "GESA CC", "GESA CC", "All
> > > > Matches", "All No Matches")
> > > > For i = UBound(NewSheets) To LBound(NewSheets) Step -1
> > > > Sheets.Add after:=Sheets(1)
> > > > ActiveSheet.Name = NewSheets(i)
> > > > Next i
> > > >
> > > > End Sub
> > > >
> > > > Sub CopyData()
> > > > Dim rng As Range, cell As Range
> > > > Dim i As Long, sh As Worksheet
> > > > With Worksheets("All Records")
> > > > Set rng = .Range(.Cells(1, 1), _
> > > > .Cells(Rows.Count, 1).End(xlUp))
> > > > End With
> > > > i = 1
> > > > Set sh = Worksheets("All Records")
> > > > For Each cell In rng
> > > > If UCase(Trim(cell.Value)) = "4-$" And _
> > > > UCase(Trim(cell.Offset( _
> > > > 0, 1).Value)) = "GESA CC" Then
> > > > cell.EntireRow.Copy sh.Cells(i, 1)
> > > > i = i + 1
> > > > End If
> > > > Next
> > > > End Sub
> > > >