I'd like to copy a certain number of columns from 1 sheet into another to
form a report - but based on criteria.

Firsly id like to tell the macro to custom filter column Z to show
everything outstanding which is "less than 0".

Once this is filtered i need to tell the macro to copy columns H-O, X, Y,
etc and then all this information would go into another sheet within the same
workbook.

Also, if i can get any code so that i can put colours/borders around the
data extracted i would be very grateful.

Please can you offer some help?

thanks.

Hello,

You can do something along the lines of this for the code:

Dim cell As Range
'Hides each row if Z >= "0"
For Each cell In Range("Z2:Z65536")
If cell.Value >= "0" Then
cell.Rows.Hidden = True
End If
Next cell
'selects columns
For Each cell In Range("Z2:Z65536")
If cell.Rows.Hidden = False Then
If cell.Value > "" Then
Range("H" & cell.Rows.Row & ":" & "O" & cell.Rows.Row & "," _
& "X" & cell.Rows.Row & ":" & "Y" & cell.Rows.Row).Select
'paste them to other sheet
Selection.Copy _
Worksheets("Sheet2").Range("A1")
End If
End If
Next cell

As for the Colors and the Borders, you can use conditional formating
to color or border the cell if the cell is <>""

I modified the code as below but its not doing what i want it to...

I added a few more columns that i want it to extract - i dont think i have
done it correctly!

Also, in the "sheet" where i want it to put this information i have stated
"report" but i would like for it to just put the information into a new sheet
because the "report" sheet may not always be there.. how do i do this?

thanks alot.

Sub tracker1()
Dim cell As Range
'Hides each row if Z >= "0"
For Each cell In Range("Z2:Z65536")
If cell.Value > "0" Then
cell.Rows.Hidden = True
End If
Next cell
'selects columns
For Each cell In Range("Z2:Z65536")
If cell.Rows.Hidden = False Then
If cell.Value > "" Then
Range("C" & cell.Rows.Row & "D" & "G" & "H" & "T" & "U" & "V" & "W" &
"X" & cell.Rows.Row & "," _
& "Y" & cell.Rows.Row & "Z" & "AM" & cell.Rows.Row).Select
'paste them to other sheet
Selection.Copy _
Worksheets("Report").Range("A1")
End If
End If
Next cell
End Sub


"GTVT06" wrote:

> Hello,
>
> You can do something along the lines of this for the code:
>
> Dim cell As Range
> 'Hides each row if Z >= "0"
> For Each cell In Range("Z2:Z65536")
> If cell.Value >= "0" Then
> cell.Rows.Hidden = True
> End If
> Next cell
> 'selects columns
> For Each cell In Range("Z2:Z65536")
> If cell.Rows.Hidden = False Then
> If cell.Value > "" Then
> Range("H" & cell.Rows.Row & ":" & "O" & cell.Rows.Row & "," _
> & "X" & cell.Rows.Row & ":" & "Y" & cell.Rows.Row).Select
> 'paste them to other sheet
> Selection.Copy _
> Worksheets("Sheet2").Range("A1")
> End If
> End If
> Next cell
>
> As for the Colors and the Borders, you can use conditional formating
> to color or border the cell if the cell is <>""
>

Please can you help on the below? also, while i was trying to fix the code
myself (having no luck!) i noticed a couple of things missing/not functioning
properly, for example, additional to if anything is 0 then hide these rows i
also want to say if anything is blank then hide these rows (within the same
column -Z). When i ran this macro although it wasnt pulling across the right
info i noticed that what it did copy across into the new sheet was literally
just one row from the spredsheet as opposed to all the selected information
to be diaplayed in a formatted way in another sheet.


please help! thanks.


"Zak" wrote:

> I modified the code as below but its not doing what i want it to...
>
> I added a few more columns that i want it to extract - i dont think i have
> done it correctly!
>
> Also, in the "sheet" where i want it to put this information i have stated
> "report" but i would like for it to just put the information into a new sheet
> because the "report" sheet may not always be there.. how do i do this?
>
> thanks alot.
>
> Sub tracker1()
> Dim cell As Range
> 'Hides each row if Z >= "0"
> For Each cell In Range("Z2:Z65536")
> If cell.Value > "0" Then
> cell.Rows.Hidden = True
> End If
> Next cell
> 'selects columns
> For Each cell In Range("Z2:Z65536")
> If cell.Rows.Hidden = False Then
> If cell.Value > "" Then
> Range("C" & cell.Rows.Row & "D" & "G" & "H" & "T" & "U" & "V" & "W" &
> "X" & cell.Rows.Row & "," _
> & "Y" & cell.Rows.Row & "Z" & "AM" & cell.Rows.Row).Select
> 'paste them to other sheet
> Selection.Copy _
> Worksheets("Report").Range("A1")
> End If
> End If
> Next cell
> End Sub
>
>
> "GTVT06" wrote:
>
> > Hello,
> >
> > You can do something along the lines of this for the code:
> >
> > Dim cell As Range
> > 'Hides each row if Z >= "0"
> > For Each cell In Range("Z2:Z65536")
> > If cell.Value >= "0" Then
> > cell.Rows.Hidden = True
> > End If
> > Next cell
> > 'selects columns
> > For Each cell In Range("Z2:Z65536")
> > If cell.Rows.Hidden = False Then
> > If cell.Value > "" Then
> > Range("H" & cell.Rows.Row & ":" & "O" & cell.Rows.Row & "," _
> > & "X" & cell.Rows.Row & ":" & "Y" & cell.Rows.Row).Select
> > 'paste them to other sheet
> > Selection.Copy _
> > Worksheets("Sheet2").Range("A1")
> > End If
> > End If
> > Next cell
> >
> > As for the Colors and the Borders, you can use conditional formating
> > to color or border the cell if the cell is <>""
> >

On Jan 21, 8:47*am, Zak <Z...@discussions.microsoft.com> wrote:
> Please can you help on the below? also, while i was trying to fix the code
> myself (having no luck!) i noticed a couple of things missing/not functioning
> properly, for example, additional to if anything is 0 then hide these rowsi
> also want to say if anything is blank then hide these rows (within the same
> column -Z). When i ran this macro although it wasnt pulling across the right
> info i noticed that what it did copy across into the new sheet was literally
> just one row from the spredsheet as opposed to all the selected information
> to be diaplayed in a formatted way in another sheet.
>
> please help! thanks.
>
>
>
> "Zak" wrote:
> > I modified the code as below but its not doing what i want it to...
>
> > I added a few more columns that i want it to extract - i dont think i have
> > done it correctly!
>
> > Also, in the "sheet" where i want it to put this information i have stated
> > "report" but i would like for it to just put the information into a new sheet
> > because the "report" sheet may not always be there.. how do i do this?
>
> > thanks alot.
>
> > Sub tracker1()
> > Dim cell As Range
> > * * 'Hides each row if Z >= "0"
> > * * For Each cell In Range("Z2:Z65536")
> > * * If cell.Value > "0" Then
> > * * cell.Rows.Hidden = True
> > * * End If
> > * * Next cell
> > * * 'selects columns
> > * * For Each cell In Range("Z2:Z65536")
> > * * If cell.Rows.Hidden = False Then
> > * * If cell.Value > "" Then
> > * * Range("C" & cell.Rows.Row & "D" & "G" & "H" & "T" & "U" & "V" & "W" &
> > "X" & cell.Rows.Row & "," _
> > * * & "Y" & cell.Rows.Row & "Z" & "AM" & cell.Rows.Row).Select
> > * * 'paste them to other sheet
> > * * Selection.Copy _
> > * * Worksheets("Report").Range("A1")
> > * * End If
> > * * End If
> > * * Next cell
> > End Sub
>
> > "GTVT06" wrote:
>
> > > Hello,
>
> > > You can do something along the lines of this for the code:
>
> > > Dim cell As Range
> > > * * 'Hides each row if Z >= "0"
> > > * * For Each cell In Range("Z2:Z65536")
> > > * * If cell.Value >= "0" Then
> > > * * cell.Rows.Hidden = True
> > > * * End If
> > > * * Next cell
> > > * * 'selects columns
> > > * * For Each cell In Range("Z2:Z65536")
> > > * * If cell.Rows.Hidden = False Then
> > > * * If cell.Value > "" Then
> > > * * Range("H" & cell.Rows.Row & ":" & "O" & cell.Rows.Row & "," _
> > > * * & "X" & cell.Rows.Row & ":" & "Y" & cell.Rows.Row).Select
> > > * * 'paste them to other sheet
> > > * * Selection.Copy _
> > > * * Worksheets("Sheet2").Range("A1")
> > > * * End If
> > > * * End If
> > > * * Next cell
>
> > > As for the Colors and the Borders, you can use conditional formating
> > > to color or border the cell if the cell is <>""- Hide quoted text -
>
> - Show quoted text -

Sorry about that, I added a quick fix so it will paste the data in
multiple rows on the other sheet. I will look into your other request
and get back with you shortly

Dim cell As Range
'Hides each row if Z >= "0"
For Each cell In Range("Z2:Z65536")
If cell.Value >= "0" Then
cell.Rows.Hidden = True
End If
Next cell
'selects columns
For Each cell In Range("Z2:Z65536")
If cell.Rows.Hidden = False Then
If cell.Value > "" Then
Range("H" & cell.Rows.Row & ":" & "O" & cell.Rows.Row & "," _
& "X" & cell.Rows.Row & ":" & "Y" & cell.Rows.Row).Select
'paste them to other sheet
Selection.Copy
Worksheets("Sheet2").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Worksheets("Activities").Activate
End If
End If
Next cellDim cell As Range
'Hides each row if Z >= "0"
For Each cell In Range("Z2:Z65536")
If cell.Value >= "0" Then
cell.Rows.Hidden = True
End If
Next cell
'selects columns
For Each cell In Range("Z2:Z65536")
If cell.Rows.Hidden = False Then
If cell.Value > "" Then
Range("H" & cell.Rows.Row & ":" & "O" & cell.Rows.Row & "," _
& "X" & cell.Rows.Row & ":" & "Y" & cell.Rows.Row).Select
'paste them to other sheet
Selection.Copy
Worksheets("Sheet2").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
rng = Worksheets("Sheet2").Range("A65536").End(xlUp).Address
Worksheets("Activities").Activate
End If
End If
Next cell

On Jan 21, 3:50*am, Zak <Z...@discussions.microsoft.com> wrote:
> I modified the code as below but its not doing what i want it to...
>
> I added a few more columns that i want it to extract - i dont think i have
> done it correctly!
>
> Also, in the "sheet" where i want it to put this information i have stated
> "report" but i would like for it to just put the information into a new sheet
> because the "report" sheet may not always be there.. how do i do this?
>
> thanks alot.
>
> Sub tracker1()
> Dim cell As Range
> * * 'Hides each row if Z >= "0"
> * * For Each cell In Range("Z2:Z65536")
> * * If cell.Value > "0" Then
> * * cell.Rows.Hidden = True
> * * End If
> * * Next cell
> * * 'selects columns
> * * For Each cell In Range("Z2:Z65536")
> * * If cell.Rows.Hidden = False Then
> * * If cell.Value > "" Then
> * * Range("C" & cell.Rows.Row & "D" & "G" & "H" & "T" & "U" & "V" & "W" &
> "X" & cell.Rows.Row & "," _
> * * & "Y" & cell.Rows.Row & "Z" & "AM" & cell.Rows.Row).Select
> * * 'paste them to other sheet
> * * Selection.Copy _
> * * Worksheets("Report").Range("A1")
> * * End If
> * * End If
> * * Next cell
> End Sub
>
>
>
> "GTVT06" wrote:
> > Hello,
>
> > You can do something along the lines of this for the code:
>
> > Dim cell As Range
> > * * 'Hides each row if Z >= "0"
> > * * For Each cell In Range("Z2:Z65536")
> > * * If cell.Value >= "0" Then
> > * * cell.Rows.Hidden = True
> > * * End If
> > * * Next cell
> > * * 'selects columns
> > * * For Each cell In Range("Z2:Z65536")
> > * * If cell.Rows.Hidden = False Then
> > * * If cell.Value > "" Then
> > * * Range("H" & cell.Rows.Row & ":" & "O" & cell.Rows.Row & "," _
> > * * & "X" & cell.Rows.Row & ":" & "Y" & cell.Rows.Row).Select
> > * * 'paste them to other sheet
> > * * Selection.Copy _
> > * * Worksheets("Sheet2").Range("A1")
> > * * End If
> > * * End If
> > * * Next cell
>
> > As for the Colors and the Borders, you can use conditional formating
> > to color or border the cell if the cell is <>""- Hide quoted text -
>
> - Show quoted text -

Here is the revised version with the revised Columns to copy.paste and
also the revisions for the "Report" sheet.

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
Dim cell As Range
Dim n As Single
Dim exist As Boolean
For n = 1 To Sheets.Count
Sheets(n).Activate
If ActiveSheet.Name = "Report" Then
exist = True
End If
Next n
If exist = False Then
Sheets("Activities").Select
Sheets.Add
ActiveSheet.Name = "Report"
End If
Worksheets("Activities").Activate
'Hides each row if Z >= "0"
For Each cell In Range("Z2:Z65536")
If cell.Value >= "0" Then
cell.Rows.Hidden = True
End If
Next cell
'selects columns
For Each cell In Range("Z2:Z65536")
If cell.Rows.Hidden = False Then
If cell.Value > "" Then
Range("C" & cell.Rows.Row & ":" & "D" & cell.Rows.Row & "," _
& "G" & cell.Rows.Row & ":" & "H" & cell.Rows.Row & "," _
& "T" & cell.Rows.Row & ":" & "Z" & cell.Rows.Row & "," _
& "AM" & cell.Rows.Row & ":" & "AM" & cell.Rows.Row).Select
'paste them to other sheet
Selection.Copy
Worksheets("Report").Activate
If Range("A1") = "" Then
Range("A1").Select
ActiveSheet.Paste
Else
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Worksheets("Activities").Activate
End If
End If
Next cell
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

I tried the code and it doesnt work! it went to error and highlighted:

"Worksheets("Activities").Activate", maybe because the "activities"
worksheet doesnt exist?

Also, i dont think you have put a code for 'if anything in column Z is
blank'..(additional to 'if anything is >0') how do i do that?

thanks for all your help.

"GTVT06" wrote:

> On Jan 21, 3:50 am, Zak <Z...@discussions.microsoft.com> wrote:
> > I modified the code as below but its not doing what i want it to...
> >
> > I added a few more columns that i want it to extract - i dont think i have
> > done it correctly!
> >
> > Also, in the "sheet" where i want it to put this information i have stated
> > "report" but i would like for it to just put the information into a new sheet
> > because the "report" sheet may not always be there.. how do i do this?
> >
> > thanks alot.
> >
> > Sub tracker1()
> > Dim cell As Range
> > 'Hides each row if Z >= "0"
> > For Each cell In Range("Z2:Z65536")
> > If cell.Value > "0" Then
> > cell.Rows.Hidden = True
> > End If
> > Next cell
> > 'selects columns
> > For Each cell In Range("Z2:Z65536")
> > If cell.Rows.Hidden = False Then
> > If cell.Value > "" Then
> > Range("C" & cell.Rows.Row & "D" & "G" & "H" & "T" & "U" & "V" & "W" &
> > "X" & cell.Rows.Row & "," _
> > & "Y" & cell.Rows.Row & "Z" & "AM" & cell.Rows.Row).Select
> > 'paste them to other sheet
> > Selection.Copy _
> > Worksheets("Report").Range("A1")
> > End If
> > End If
> > Next cell
> > End Sub
> >
> >
> >
> > "GTVT06" wrote:
> > > Hello,
> >
> > > You can do something along the lines of this for the code:
> >
> > > Dim cell As Range
> > > 'Hides each row if Z >= "0"
> > > For Each cell In Range("Z2:Z65536")
> > > If cell.Value >= "0" Then
> > > cell.Rows.Hidden = True
> > > End If
> > > Next cell
> > > 'selects columns
> > > For Each cell In Range("Z2:Z65536")
> > > If cell.Rows.Hidden = False Then
> > > If cell.Value > "" Then
> > > Range("H" & cell.Rows.Row & ":" & "O" & cell.Rows.Row & "," _
> > > & "X" & cell.Rows.Row & ":" & "Y" & cell.Rows.Row).Select
> > > 'paste them to other sheet
> > > Selection.Copy _
> > > Worksheets("Sheet2").Range("A1")
> > > End If
> > > End If
> > > Next cell
> >
> > > As for the Colors and the Borders, you can use conditional formating
> > > to color or border the cell if the cell is <>""- Hide quoted text -
> >
> > - Show quoted text -
>
> Here is the revised version with the revised Columns to copy.paste and
> also the revisions for the "Report" sheet.
>
> With Application
> .DisplayAlerts = False
> .EnableEvents = False
> .ScreenUpdating = False
> End With
> Dim cell As Range
> Dim n As Single
> Dim exist As Boolean
> For n = 1 To Sheets.Count
> Sheets(n).Activate
> If ActiveSheet.Name = "Report" Then
> exist = True
> End If
> Next n
> If exist = False Then
> Sheets("Activities").Select
> Sheets.Add
> ActiveSheet.Name = "Report"
> End If
> Worksheets("Activities").Activate
> 'Hides each row if Z >= "0"
> For Each cell In Range("Z2:Z65536")
> If cell.Value >= "0" Then
> cell.Rows.Hidden = True
> End If
> Next cell
> 'selects columns
> For Each cell In Range("Z2:Z65536")
> If cell.Rows.Hidden = False Then
> If cell.Value > "" Then
> Range("C" & cell.Rows.Row & ":" & "D" & cell.Rows.Row & "," _
> & "G" & cell.Rows.Row & ":" & "H" & cell.Rows.Row & "," _
> & "T" & cell.Rows.Row & ":" & "Z" & cell.Rows.Row & "," _
> & "AM" & cell.Rows.Row & ":" & "AM" & cell.Rows.Row).Select
> 'paste them to other sheet
> Selection.Copy
> Worksheets("Report").Activate
> If Range("A1") = "" Then
> Range("A1").Select
> ActiveSheet.Paste
> Else
> Range("A65536").End(xlUp).Offset(1, 0).Select
> ActiveSheet.Paste
> Application.CutCopyMode = False
> End If
> Worksheets("Activities").Activate
> End If
> End If
> Next cell
> With Application
> .DisplayAlerts = True
> .EnableEvents = True
> .ScreenUpdating = True
> End With
>

On Jan 21, 2:02*pm, Zak <Z...@discussions.microsoft.com> wrote:
> I tried the code and it doesnt work! it went to error and highlighted:
>
> "Worksheets("Activities").Activate", maybe because the "activities"
> worksheet doesnt exist?
>
> Also, i dont think you have put a code for 'if anything in column Z is
> blank'..(additional to 'if anything is >0') how do i do that?
>
> thanks for all your help.
>
>
>
> "GTVT06" wrote:
> > On Jan 21, 3:50 am, Zak <Z...@discussions.microsoft.com> wrote:
> > > I modified the code as below but its not doing what i want it to...
>
> > > I added a few more columns that i want it to extract - i dont think i have
> > > done it correctly!
>
> > > Also, in the "sheet" where i want it to put this information i have stated
> > > "report" but i would like for it to just put the information into a new sheet
> > > because the "report" sheet may not always be there.. how do i do this?
>
> > > thanks alot.
>
> > > Sub tracker1()
> > > Dim cell As Range
> > > * * 'Hides each row if Z >= "0"
> > > * * For Each cell In Range("Z2:Z65536")
> > > * * If cell.Value > "0" Then
> > > * * cell.Rows.Hidden = True
> > > * * End If
> > > * * Next cell
> > > * * 'selects columns
> > > * * For Each cell In Range("Z2:Z65536")
> > > * * If cell.Rows.Hidden = False Then
> > > * * If cell.Value > "" Then
> > > * * Range("C" & cell.Rows.Row & "D" & "G" & "H" & "T" & "U" & "V" & "W" &
> > > "X" & cell.Rows.Row & "," _
> > > * * & "Y" & cell.Rows.Row & "Z" & "AM" & cell.Rows.Row).Select
> > > * * 'paste them to other sheet
> > > * * Selection.Copy _
> > > * * Worksheets("Report").Range("A1")
> > > * * End If
> > > * * End If
> > > * * Next cell
> > > End Sub
>
> > > "GTVT06" wrote:
> > > > Hello,
>
> > > > You can do something along the lines of this for the code:
>
> > > > Dim cell As Range
> > > > * * 'Hides each row if Z >= "0"
> > > > * * For Each cell In Range("Z2:Z65536")
> > > > * * If cell.Value >= "0" Then
> > > > * * cell.Rows.Hidden = True
> > > > * * End If
> > > > * * Next cell
> > > > * * 'selects columns
> > > > * * For Each cell In Range("Z2:Z65536")
> > > > * * If cell.Rows.Hidden = False Then
> > > > * * If cell.Value > "" Then
> > > > * * Range("H" & cell.Rows.Row & ":" & "O" & cell.Rows.Row & "," _
> > > > * * & "X" & cell.Rows.Row & ":" & "Y" & cell.Rows.Row).Select
> > > > * * 'paste them to other sheet
> > > > * * Selection.Copy _
> > > > * * Worksheets("Sheet2").Range("A1")
> > > > * * End If
> > > > * * End If
> > > > * * Next cell
>
> > > > As for the Colors and the Borders, you can use conditional formating
> > > > to color or border the cell if the cell is <>""- Hide quoted text -
>
> > > - Show quoted text -
>
> > Here is the revised version with the revised Columns to copy.paste and
> > also the revisions for the "Report" sheet.
>
> > With Application
> > * * .DisplayAlerts = False
> > * * .EnableEvents = False
> > * * .ScreenUpdating = False
> > End With
> > Dim cell As Range
> > * * Dim n As Single
> > * * Dim exist As Boolean
> > * *For n = 1 To Sheets.Count
> > * * * * Sheets(n).Activate
> > * * * * If ActiveSheet.Name = "Report" Then
> > * * * * exist = True
> > * * * * End If
> > * * * * Next n
> > * * If exist = False Then
> > * * Sheets("Activities").Select
> > * * Sheets.Add
> > * * ActiveSheet.Name = "Report"
> > * * End If
> > * * Worksheets("Activities").Activate
> > * * 'Hides each row if Z >= "0"
> > * * For Each cell In Range("Z2:Z65536")
> > * * If cell.Value >= "0" Then
> > * * cell.Rows.Hidden = True
> > * * End If
> > * * Next cell
> > * * 'selects columns
> > * * For Each cell In Range("Z2:Z65536")
> > * * If cell.Rows.Hidden = False Then
> > * * If cell.Value > "" Then
> > * * Range("C" & cell.Rows.Row & ":" & "D" & cell.Rows.Row & "," _
> > * * & "G" & cell.Rows.Row & ":" & "H" & cell.Rows.Row & "," _
> > * * & "T" & cell.Rows.Row & ":" & "Z" & cell.Rows.Row & "," _
> > * * & "AM" & cell.Rows.Row & ":" & "AM" & cell.Rows.Row).Select
> > * * 'paste them to other sheet
> > * * Selection.Copy
> > * * Worksheets("Report").Activate
> > * * If Range("A1") = "" Then
> > * * Range("A1").Select
> > * * ActiveSheet.Paste
> > * * Else
> > * * * * Range("A65536").End(xlUp).Offset(1, 0).Select
> > * * ActiveSheet.Paste
> > * * Application.CutCopyMode = False
> > * * End If
> > * * Worksheets("Activities").Activate
> > * * End If
> > * * End If
> > * * Next cell
> > With Application
> > * * .DisplayAlerts = True
> > * * .EnableEvents = True
> > * * .ScreenUpdating = True
> > End With- Hide quoted text -
>
> - Show quoted text -

Sorry Rename the Activites sheet to the appropriate name of the sheet
that has all of the data that we are copying from. Not sure what the
name is... And I'll modify to hide all blanks also, I forgot about
that

On Jan 21, 2:02*pm, Zak <Z...@discussions.microsoft.com> wrote:
> I tried the code and it doesnt work! it went to error and highlighted:
>
> "Worksheets("Activities").Activate", maybe because the "activities"
> worksheet doesnt exist?
>
> Also, i dont think you have put a code for 'if anything in column Z is
> blank'..(additional to 'if anything is >0') how do i do that?
>
> thanks for all your help.


Here you go. This will hide the blanks as well. Once again you'd have
to replace "Activities" to the actual sheet name of the sheet with the
source data.

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
Dim cell As Range
Dim n As Single
Dim exist As Boolean
For n = 1 To Sheets.Count
Sheets(n).Activate
If ActiveSheet.Name = "Report" Then
exist = True
End If
Next n
If exist = False Then
Sheets("Activities").Select
Sheets.Add
ActiveSheet.Name = "Report"
End If
Worksheets("Activities").Activate
'Hides each row if Z >= "0"
For Each cell In Range("Z2:Z65536")
If cell.Value >= "0" Then
cell.Rows.Hidden = True
End If
Next cell
'Hide row if Column Z is blank
Dim lrow As Variant
lrow =
Worksheets("Activities").Range("Z65536").End(xlUp).Offset(1, 0).Row
Rows(lrow & ":65536").Hidden = True
'selects columns
For Each cell In Range("Z2:Z65536")
If cell.Rows.Hidden = False Then
If cell.Value > "" Then
Range("C" & cell.Rows.Row & ":" & "D" & cell.Rows.Row & "," _
& "G" & cell.Rows.Row & ":" & "H" & cell.Rows.Row & "," _
& "T" & cell.Rows.Row & ":" & "Z" & cell.Rows.Row & "," _
& "AM" & cell.Rows.Row & ":" & "AM" & cell.Rows.Row).Select
'paste them to other sheet
Selection.Copy
Worksheets("Report").Activate
If Range("A1") = "" Then
Range("A1").Select
ActiveSheet.Paste
Else
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Worksheets("Activities").Activate
End If
End If
Next cell
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

Can anyone please reply to this as soon as you can, i really need to sort
this quickly for a presentation. i really hope you can get back to me asap.

thanks in advance.

"Zak" wrote:

> I tried the code and it doesnt work! it went to error and highlighted:
>
> "Worksheets("Activities").Activate", maybe because the "activities"
> worksheet doesnt exist?
>
> Also, i dont think you have put a code for 'if anything in column Z is
> blank'..(additional to 'if anything is >0') how do i do that?
>
> thanks for all your help.
>
> "GTVT06" wrote:
>
> > On Jan 21, 3:50 am, Zak <Z...@discussions.microsoft.com> wrote:
> > > I modified the code as below but its not doing what i want it to...
> > >
> > > I added a few more columns that i want it to extract - i dont think i have
> > > done it correctly!
> > >
> > > Also, in the "sheet" where i want it to put this information i have stated
> > > "report" but i would like for it to just put the information into a new sheet
> > > because the "report" sheet may not always be there.. how do i do this?
> > >
> > > thanks alot.
> > >
> > > Sub tracker1()
> > > Dim cell As Range
> > > 'Hides each row if Z >= "0"
> > > For Each cell In Range("Z2:Z65536")
> > > If cell.Value > "0" Then
> > > cell.Rows.Hidden = True
> > > End If
> > > Next cell
> > > 'selects columns
> > > For Each cell In Range("Z2:Z65536")
> > > If cell.Rows.Hidden = False Then
> > > If cell.Value > "" Then
> > > Range("C" & cell.Rows.Row & "D" & "G" & "H" & "T" & "U" & "V" & "W" &
> > > "X" & cell.Rows.Row & "," _
> > > & "Y" & cell.Rows.Row & "Z" & "AM" & cell.Rows.Row).Select
> > > 'paste them to other sheet
> > > Selection.Copy _
> > > Worksheets("Report").Range("A1")
> > > End If
> > > End If
> > > Next cell
> > > End Sub
> > >
> > >
> > >
> > > "GTVT06" wrote:
> > > > Hello,
> > >
> > > > You can do something along the lines of this for the code:
> > >
> > > > Dim cell As Range
> > > > 'Hides each row if Z >= "0"
> > > > For Each cell In Range("Z2:Z65536")
> > > > If cell.Value >= "0" Then
> > > > cell.Rows.Hidden = True
> > > > End If
> > > > Next cell
> > > > 'selects columns
> > > > For Each cell In Range("Z2:Z65536")
> > > > If cell.Rows.Hidden = False Then
> > > > If cell.Value > "" Then
> > > > Range("H" & cell.Rows.Row & ":" & "O" & cell.Rows.Row & "," _
> > > > & "X" & cell.Rows.Row & ":" & "Y" & cell.Rows.Row).Select
> > > > 'paste them to other sheet
> > > > Selection.Copy _
> > > > Worksheets("Sheet2").Range("A1")
> > > > End If
> > > > End If
> > > > Next cell
> > >
> > > > As for the Colors and the Borders, you can use conditional formating
> > > > to color or border the cell if the cell is <>""- Hide quoted text -
> > >
> > > - Show quoted text -
> >
> > Here is the revised version with the revised Columns to copy.paste and
> > also the revisions for the "Report" sheet.
> >
> > With Application
> > .DisplayAlerts = False
> > .EnableEvents = False
> > .ScreenUpdating = False
> > End With
> > Dim cell As Range
> > Dim n As Single
> > Dim exist As Boolean
> > For n = 1 To Sheets.Count
> > Sheets(n).Activate
> > If ActiveSheet.Name = "Report" Then
> > exist = True
> > End If
> > Next n
> > If exist = False Then
> > Sheets("Activities").Select
> > Sheets.Add
> > ActiveSheet.Name = "Report"
> > End If
> > Worksheets("Activities").Activate
> > 'Hides each row if Z >= "0"
> > For Each cell In Range("Z2:Z65536")
> > If cell.Value >= "0" Then
> > cell.Rows.Hidden = True
> > End If
> > Next cell
> > 'selects columns
> > For Each cell In Range("Z2:Z65536")
> > If cell.Rows.Hidden = False Then
> > If cell.Value > "" Then
> > Range("C" & cell.Rows.Row & ":" & "D" & cell.Rows.Row & "," _
> > & "G" & cell.Rows.Row & ":" & "H" & cell.Rows.Row & "," _
> > & "T" & cell.Rows.Row & ":" & "Z" & cell.Rows.Row & "," _
> > & "AM" & cell.Rows.Row & ":" & "AM" & cell.Rows.Row).Select
> > 'paste them to other sheet
> > Selection.Copy
> > Worksheets("Report").Activate
> > If Range("A1") = "" Then
> > Range("A1").Select
> > ActiveSheet.Paste
> > Else
> > Range("A65536").End(xlUp).Offset(1, 0).Select
> > ActiveSheet.Paste
> > Application.CutCopyMode = False
> > End If
> > Worksheets("Activities").Activate
> > End If
> > End If
> > Next cell
> > With Application
> > .DisplayAlerts = True
> > .EnableEvents = True
> > .ScreenUpdating = True
> > End With
> >