View Full Version : Solved: Make a Summary Sheet
jammer6_9
07-02-2013, 08:47 AM
Below code gives me specific row which row 6 to copy specific values. Now i want to copy all values which is not null from row 6 to row 75 :dunno
Sub Make_Summary()
Dim Ws As Worksheet, LstRw As Long
LstRw = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row
With Sheets("Summary")
.Range("A3:B" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets
If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then
.Cells(NxtRw, "A").Value = Ws.Range("a6")
.Cells(NxtRw, "B").Value = Ws.Range("b6")
.Cells(NxtRw, "c").Value = Ws.Range("c6")
.Cells(NxtRw, "d").Value = Ws.Range("d6")
.Cells(NxtRw, "e").Value = Ws.Range("e6")
.Cells(NxtRw, "f").Value = Ws.Range("f6")
.Cells(NxtRw, "g").Value = Ws.Range("g6")
NxtRw = NxtRw + 1
End If
Next Ws
End With
End Sub
Sheets("Summary").Rows("6:75").Copy
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Template" And Not ws.Name = "Summary" Then _
ws.Range("A3").PasteSpecial xlValues, SkipBlanks:=True
Next ws
PasteSpecial xlValues means only paste values. SkipBlanks:=True means don't paste Nulls.
jammer6_9
07-02-2013, 09:38 PM
It doesnt give me anything. Am i going to add this in my code? What I meant to say is how can I combine the code below to copy rows down in all the sheets source
Sub Row1()
Dim Ws As Worksheet, LstRw As Long
LstRw = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).row
With Sheets("Summary")
.Range("A3:g" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets
If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then
.Cells(NxtRw, "A").Value = Ws.Range("a6")
.Cells(NxtRw, "B").Value = Ws.Range("b6")
.Cells(NxtRw, "c").Value = Ws.Range("c6")
.Cells(NxtRw, "d").Value = Ws.Range("d6")
.Cells(NxtRw, "e").Value = Ws.Range("e6")
.Cells(NxtRw, "f").Value = Ws.Range("f6")
.Cells(NxtRw, "g").Value = Ws.Range("g6")
NxtRw = NxtRw + 1
.Cells(NxtRw, "A").Value = Ws.Range("a6")
.Cells(NxtRw, "B").Value = Ws.Range("b6")
.Cells(NxtRw, "c").Value = Ws.Range("c6")
.Cells(NxtRw, "d").Value = Ws.Range("d6")
.Cells(NxtRw, "e").Value = Ws.Range("e6")
.Cells(NxtRw, "f").Value = Ws.Range("h6")
.Cells(NxtRw, "g").Value = Ws.Range("i6")
NxtRw = NxtRw + 1
.Cells(NxtRw, "A").Value = Ws.Range("a6")
.Cells(NxtRw, "B").Value = Ws.Range("b6")
.Cells(NxtRw, "c").Value = Ws.Range("c6")
.Cells(NxtRw, "d").Value = Ws.Range("d6")
.Cells(NxtRw, "e").Value = Ws.Range("e6")
.Cells(NxtRw, "f").Value = Ws.Range("j6")
.Cells(NxtRw, "g").Value = Ws.Range("k6")
NxtRw = NxtRw + 1
End If
Next Ws
End With
End Sub
Sub Row2()
Dim Ws As Worksheet, LstRw As Long
LstRw = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).row
With Sheets("Summary")
' .Range("A3:g" & LstRw).ClearContents
LstRw = LstRw
For Each Ws In ThisWorkbook.Worksheets
If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then
.Cells(LstRw, "A").Value = Ws.Range("a7")
.Cells(LstRw, "B").Value = Ws.Range("b7")
.Cells(LstRw, "c").Value = Ws.Range("c7")
.Cells(LstRw, "d").Value = Ws.Range("d7")
.Cells(LstRw, "e").Value = Ws.Range("e7")
.Cells(LstRw, "f").Value = Ws.Range("f7")
.Cells(LstRw, "g").Value = Ws.Range("g7")
LstRw = LstRw + 1
.Cells(LstRw, "A").Value = Ws.Range("a7")
.Cells(LstRw, "B").Value = Ws.Range("b7")
.Cells(LstRw, "c").Value = Ws.Range("c7")
.Cells(LstRw, "d").Value = Ws.Range("d7")
.Cells(LstRw, "e").Value = Ws.Range("e7")
.Cells(LstRw, "f").Value = Ws.Range("h7")
.Cells(LstRw, "g").Value = Ws.Range("i7")
LstRw = LstRw + 1
.Cells(LstRw, "A").Value = Ws.Range("a7")
.Cells(LstRw, "B").Value = Ws.Range("b7")
.Cells(LstRw, "c").Value = Ws.Range("c7")
.Cells(LstRw, "d").Value = Ws.Range("d7")
.Cells(LstRw, "e").Value = Ws.Range("e7")
.Cells(LstRw, "f").Value = Ws.Range("j7")
.Cells(LstRw, "g").Value = Ws.Range("k7")
LstRw = LstRw + 1
End If
Next Ws
End With
End Sub
Sheets("Summary").Rows("6:75").Copy
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Template" And Not ws.Name = "Summary" Then _
ws.Range("A3").PasteSpecial xlValues, SkipBlanks:=True
Next ws
PasteSpecial xlValues means only paste values. SkipBlanks:=True means don't paste Nulls.
p45cal
07-02-2013, 11:47 PM
re:"copy all values which is not null"
SamT gave you a solution for exactly what you asked for, however I suspect that what you asked for is not what you wanted.
What "is not null"?:
Must all cells in a given row be "not null" (empty?)?
A whole row of empty cells from column A to G?
Just one of these cells in columns A to G in a given row?
Perhaps several empty cells in a given row?
or perhaps an empty cell in a specific column qualifies the row not to be copied?
Have you tried autofiltering the range to be copied before copying it? If that works, record a macro of your doing it and paste the code here - we'll tweak.
jammer6_9
07-03-2013, 12:05 AM
Yeah I guess I have ask a wrong question... Forgetting null, with my above code, instead of going row1 and row2 until row 75, is there a way to combine the codings?
re:"copy all values which is not null"
SamT gave you a solution for exactly what you saked for, however I suspect that what you asked for is not what you wanted.
What "is not null"?:
Must all cells in a given row be "not null" (empty?)?
A whole row of empty cells from column A to G?
Just one of these cells in columns A to G in a given row?
Perhaps several empty cells in a given row?
or perhaps an empty cell in a specific column qualifies the row not to be copied?
Have you tried autofiltering the range to be copied before copying it? If that works, record a macro of your doing it and paste the code here - we'll tweak.
p45cal
07-03-2013, 12:30 AM
Sub Make_Summary()
Dim Ws As Worksheet, LstRw As Long
With Sheets("Summary")
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A3:G" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets
If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then
.Cells(NxtRw, "A").Resize(70, 7).Value = Ws.Range("A6:G75").Value
NxtRw = NxtRw + 70
End If
Next Ws
End With
End Sub
jammer6_9
07-03-2013, 12:48 AM
Thaw was a fast consolidation of sheet :whistle: related to my post No.1... Could you check my post No.3 and check the possibility of combining it...
Sub Make_Summary()
Dim Ws As Worksheet, LstRw As Long
With Sheets("Summary")
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A3:G" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets
If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then
.Cells(NxtRw, "A").Resize(70, 7).Value = Ws.Range("A6:G75").Value
NxtRw = NxtRw + 70
End If
Next Ws
End With
End Sub
p45cal
07-03-2013, 12:59 AM
I'm not with you.
The macro Row1 in msg#3 seems to copy row 1 of the source sheet to the Summary sheet 3 times, and Row2 seems to do the same thing with row 2. This is what you want?
edit post posting: Oh, I see a difference now, the second and 3rd copies are different in the source columns.
jammer6_9
07-03-2013, 01:03 AM
The row 2 have different copy range
.Cells(NxtRw, "A").Value = Ws.Range("a6")
.Cells(NxtRw, "B").Value = Ws.Range("b6")
.Cells(NxtRw, "c").Value = Ws.Range("c6")
.Cells(NxtRw, "d").Value = Ws.Range("d6")
.Cells(NxtRw, "e").Value = Ws.Range("e6")
.Cells(NxtRw, "f").Value = Ws.Range("f6")
.Cells(NxtRw, "g").Value = Ws.Range("g6")
NxtRw = NxtRw + 1
.Cells(NxtRw, "A").Value = Ws.Range("a6")
.Cells(NxtRw, "B").Value = Ws.Range("b6")
.Cells(NxtRw, "c").Value = Ws.Range("c6")
.Cells(NxtRw, "d").Value = Ws.Range("d6")
.Cells(NxtRw, "e").Value = Ws.Range("e6")
.Cells(NxtRw, "f").Value = Ws.Range("h6")
.Cells(NxtRw, "g").Value = Ws.Range("i6")
NxtRw = NxtRw + 1
.Cells(NxtRw, "A").Value = Ws.Range("a6")
.Cells(NxtRw, "B").Value = Ws.Range("b6")
.Cells(NxtRw, "c").Value = Ws.Range("c6")
.Cells(NxtRw, "d").Value = Ws.Range("d6")
.Cells(NxtRw, "e").Value = Ws.Range("e6")
.Cells(NxtRw, "f").Value = Ws.Range("j6")
.Cells(NxtRw, "g").Value = Ws.Range("k6")
I'm not with you.
The macro Row1 in msg#3 seems to copy row 1 of the source sheet to the Summary sheet 3 times, and Row2 seems to do the same thing with row 2. This is what you want?
jammer6_9
07-03-2013, 01:08 AM
Hi am attaching the file :thumb
p45cal
07-03-2013, 01:36 AM
I haven't looked at your attachment yet, but try:Sub Make_Summary()
Dim Ws As Worksheet, LstRw As Long
With Sheets("Summary")
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A3:G" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets
If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then
For Each rw In Ws.Range("A6:E75").Rows
.Cells(NxtRw, "A").Resize(3, 5).Value = rw.Value
For i = 0 To 2
.Cells(NxtRw, "F").Offset(i).Resize(, 2).Value = rw.Offset(, 5 + i * 2).Resize(, 2).Value
Next i
NxtRw = NxtRw + 3
Next rw
End If
Next Ws
End With
End Sub
jammer6_9
07-03-2013, 01:57 AM
Exactly what I was asking for :beerchug: Thanks!
Next to this is Filtering the summary which I guess I can do it :think: but then I know that you will be here in case!
I haven't looked at your attachment yet, but try:Sub Make_Summary()
Dim Ws As Worksheet, LstRw As Long
With Sheets("Summary")
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A3:G" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets
If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then
For Each rw In Ws.Range("A6:E75").Rows
.Cells(NxtRw, "A").Resize(3, 5).Value = rw.Value
For i = 0 To 2
.Cells(NxtRw, "F").Offset(i).Resize(, 2).Value = rw.Offset(, 5 + i * 2).Resize(, 2).Value
Next i
NxtRw = NxtRw + 3
Next rw
End If
Next Ws
End With
End Sub
p45cal
07-03-2013, 02:03 AM
an update after looking at your file:Sub Make_Summary()
Dim Ws As Worksheet, LstRw As Long
With Sheets("Summary")
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A3:G" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets
If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then
For Each rw In Ws.Range("A6:E75").Rows
For i = 0 To 2
If Application.CountBlank(rw.Offset(, 5 + i * 2).Resize(, 2)) < 2 Then
.Cells(NxtRw, "A").Resize(, 5).Value = rw.Value
.Cells(NxtRw, "F").Resize(, 2).Value = rw.Offset(, 5 + i * 2).Resize(, 2).Value
NxtRw = NxtRw + 1
End If
Next i
Next rw
End If
Next Ws
End With
End Sub
jammer6_9
07-03-2013, 02:11 AM
Just one thing I have notice, there was some employee but not all record in second row that is missing, Column I of the source sheets.
jammer6_9
07-03-2013, 02:12 AM
Oppps still some records are not showing with the update
jammer6_9
07-03-2013, 02:19 AM
an update after looking at your file:Sub Make_Summary()
Dim Ws As Worksheet, LstRw As Long
With Sheets("Summary")
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A3:G" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets
If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then
For Each rw In Ws.Range("A6:E75").Rows
For i = 0 To 2
If Application.CountBlank(rw.Offset(, 5 + i * 2).Resize(, 2)) < 2 Then
.Cells(NxtRw, "A").Resize(, 5).Value = rw.Value
.Cells(NxtRw, "F").Resize(, 2).Value = rw.Offset(, 5 + i * 2).Resize(, 2).Value
NxtRw = NxtRw + 1
End If
Next i
Next rw
End If
Next Ws
End With
End Sub
p45cal
07-03-2013, 02:56 AM
In Excel's Options, you have in the Advanced section, in the Display Options for this worksheet in the Show a zero in cells that have zero value check box unchecked. The values that are apparently missing are all 12:00AM. They are there (select one and look at the formula bar).
jammer6_9
07-03-2013, 02:59 AM
Damn me:banghead: Great! Thanks once again!:thumb
In Excel's Options, you have in the Advanced section, in the Display Options for this worksheet in the Show a zero in cells that have zero value check box unchecked. The values that are apparently missing are all 12:00AM. They are there (select one and look at the formula bar).
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.