PDA

View Full Version : Copying data from one sheet to another


austenr
09-04-2007, 08:49 AM
I need to pull data from the sheet called "summary" to a sheet called "report" in the attached workbook. The code below is what builds the report.
Sub BuildReport()
Dim sht As Object
Dim intNum As Integer
Sheets("Report").Activate
intNum = 0
ActiveSheet.AutoFilterMode = False
Range("baseTable").CurrentRegion.Clear
Range("baseTable").Value = "Case"
Range("baseTable").Offset(0, 1).Value = "Student"
Range("baseTable").Offset(0, 2).Value = "Cold Call"
Range("baseTable").Offset(0, 3).Value = "Score"
Range("baseTable").Offset(0, 4).Value = "Comment"
Range("baseTable").Offset(0, 5).Value = "Scribe's Comment"
Range("baseTable").Offset(0, 6).Value = "M/F"
Range("baseTable").Offset(0, 7).Value = "Foreign"
Range("baseTable").Offset(0, 8).Value = "US"
Range("baseTable").Offset(0, 9).Value = "Citizenship"
Range("baseTable").Offset(0, 10).Value = "Area"
For Each sht In ActiveWorkbook.Sheets
Select Case sht.Name
Case "Instructions"
Case "Summary"
Case "Report"
Case "base case"

Case Else
' paste case name, first col
Sheets("Report").Range("baseTable").Offset(1 + (120 * intNum), 0).Resize(120, 1).Value = sht.Name

' paste student name, 1 cell over
Sheets("Summary").Range("insertHere").Offset(8, 0).Resize(120, 1).Copy
Sheets("Report").Activate
Sheets("Report").Range("baseTable").Offset(1 + (120 * intNum), 1).Select
Selection.PasteSpecial (xlPasteValues)

' paste cold call column, 2 cells over
sht.Range("B4:B123").Copy
Sheets("Report").Activate
Sheets("Report").Range("baseTable").Offset(1 + (120 * intNum), 2).Select
ActiveSheet.Paste

' paste eval & comments cols, 3 cells over
sht.Range("E4:G123").Copy
Sheets("Report").Activate
Sheets("Report").Range("baseTable").Offset(1 + (120 * intNum), 3).Select
ActiveSheet.Paste

' paste m/f, seating area
Sheets("Summary").Range("insertHere").Offset(8, 6).Resize(120, 2).Copy
Sheets("Report").Activate
Sheets("Report").Range("baseTable").Offset(1 + (120 * intNum), 6).Select
Selection.PasteSpecial (xlPasteValues)
intNum = intNum + 1
End Select
Next sht

Sheets("Report").Range("baseTable").Select
Selection.AutoFilter
DeleteEmptyRows

'add the formulas that were messed up when the rows were deleted
Range("Sum").Formula = "=SUBTOTAL(9,E10:E15000)"
Range("Average").Formula = "=SUBTOTAL(1,E10:E15000)"
Range("Count").Formula = "=SUBTOTAL(2,E10:E15000)"
Range("StdDev").Formula = "=SUBTOTAL(7,E10:E15000)"
End Sub

I had to add several fields to the end of the report "Foreign", "US", "Citizenship" and "Area".

I know the Case Else is where the data is being pulled from the summary sheet but it looks like several fields are being multiplied by 120. Im not sure how to move the new data over because I dont understand what the Case statements are doing. Can someone explain them? Thanks
mdmackillop
09-04-2007, 09:23 AM
Hi Austen
120*intnum is used to calculate the row where the data is to be pasted i.e. every 120 rows
austenr
09-04-2007, 09:27 AM
So it is the same as i = 1 to 120?
mdmackillop
09-04-2007, 09:43 AM
No.
It's the same as
For i = 1 to 10000 Step 120
austenr
09-04-2007, 09:44 AM
Something odd. I augmented the code above with what is below. The first column "Foreign" copies all of the data. The other three columns stop pasting after 10 cells each.

Sub BuildReport()
Dim sht As Object
Dim intNum As Integer
Sheets("Report").Activate
intNum = 0
ActiveSheet.AutoFilterMode = False
Range("baseTable").CurrentRegion.Clear
Range("baseTable").Value = "Case"
Range("baseTable").Offset(0, 1).Value = "Student"
Range("baseTable").Offset(0, 2).Value = "Cold Call"
Range("baseTable").Offset(0, 3).Value = "Score"
Range("baseTable").Offset(0, 4).Value = "Comment"
Range("baseTable").Offset(0, 5).Value = "Scribe's Comment"
Range("baseTable").Offset(0, 6).Value = "M/F"
Range("baseTable").Offset(0, 7).Value = "Foreign"
Range("baseTable").Offset(0, 8).Value = "US"
Range("baseTable").Offset(0, 9).Value = "Citizenship"
Range("baseTable").Offset(0, 10).Value = "Area"
For Each sht In ActiveWorkbook.Sheets
Select Case sht.Name
Case "Instructions"
Case "Summary"
Case "Report"
Case "base case"

Case Else
' paste case name, first col
Sheets("Report").Range("baseTable").Offset(1 + (120 * intNum), 0).Resize(120, 1).Value = sht.Name

' paste student name, 1 cell over
Sheets("Summary").Range("insertHere").Offset(8, 0).Resize(120, 1).Copy
Sheets("Report").Activate
Sheets("Report").Range("baseTable").Offset(1 + (120 * intNum), 1).Select
Selection.PasteSpecial (xlPasteValues)

' paste cold call column, 2 cells over
sht.Range("B4:B123").Copy
Sheets("Report").Activate
Sheets("Report").Range("baseTable").Offset(1 + (120 * intNum), 2).Select
ActiveSheet.Paste

' paste eval & comments cols, 3 cells over
sht.Range("E4:G123").Copy
Sheets("Report").Activate
Sheets("Report").Range("baseTable").Offset(1 + (120 * intNum), 3).Select
ActiveSheet.Paste

' paste m/f, seating area
Sheets("Summary").Range("insertHere").Offset(8, 6).Resize(120, 2).Copy
Sheets("Report").Activate
Sheets("Report").Range("baseTable").Offset(1 + (120 * intNum), 6).Select
Selection.PasteSpecial (xlPasteValues)
intNum = intNum + 1

'paste Foreign
Sheets("Summary").Range("AI9:AI128").Copy
Sheets("Report").Activate
Range("I10").Select
Selection.PasteSpecial (xlPasteValues)

'paste US
Sheets("Summary").Range("AJ9:AJ129").Copy
Sheets("Report").Activate
Range("J10").Select
Selection.PasteSpecial (xlPasteValues)

'paste Citizenship
Sheets("Summary").Range("AK9:AK129").Copy
Sheets("Report").Activate
Range("K10").Select
Selection.PasteSpecial (xlPasteValues)

'paste Area
Sheets("Summary").Range("AL9:AL129").Copy
Sheets("Report").Activate
Range("L10").Select
Selection.PasteSpecial (xlPasteValues)

End Select
Next sht

Sheets("Report").Range("baseTable").Select
Selection.AutoFilter
DeleteEmptyRows

'add the formulas that were messed up when the rows were deleted
Range("Sum").Formula = "=SUBTOTAL(9,E10:E15000)"
Range("Average").Formula = "=SUBTOTAL(1,E10:E15000)"
Range("Count").Formula = "=SUBTOTAL(2,E10:E15000)"
Range("StdDev").Formula = "=SUBTOTAL(7,E10:E15000)"
End Sub
austenr
09-04-2007, 09:49 AM
oh ok.
austenr
09-04-2007, 10:52 AM
I figured out the rest of my code but it still doesnot work. This code works fine:

'paste foreign
Sheets("Summary").Range("insertHere").Offset(8, 7).Resize(120, 3).Copy
Sheets("Report").Activate
Sheets("Report").Range("baseTable").Offset(1 + (120 * intNum), 7).Select
Selection.PasteSpecial (xlPasteValues)
intNum = intNum + 1

However, when I try to go over one column on the summary sheet with this code:

'paste US
Sheets("Summary").Range("insertHere").Offset(8, 8).Resize(120, 4).Copy
Sheets("Report").Activate
Sheets("Report").Range("baseTable").Offset(1 + (120 * intNum), 8).Select
Selection.PasteSpecial (xlPasteValues)
intNum = intNum + 1

I get no data returned.

Also what is this doing:

intNum = intNum + 1
mdmackillop
09-04-2007, 11:07 AM
Sheets("Summary").Range("insertHere").Offset(8, 7).Resize(120, 3).Copy
Sheets("Summary").Range("insertHere").Offset(8, 8).Resize(120, 4).Copy
Check out these 2 lines. They will copy overlapping ranges.
eg like copying columns B-E then copying C-G

IntNum is multiplied by 120 so you can paste 120 rows of data below each other.
Can you post your workbook?
austenr
09-04-2007, 12:27 PM
Hi Malcomb,

Its posted in the original post.
mdmackillop
09-04-2007, 01:54 PM
Hi Austen
I've tidied up your code a bit to make it clearer
Sub BuildReport()
Dim sht As Object
Dim intNum As Integer, Rw As Long
Dim arr
Dim wsRep As Worksheet, wsSumm As Worksheet

Set wsRep = Sheets("Report")
Set wsSumm = Sheets("Summary")

'Set values
arr = Array("Case", "Student", "Cold Call", "Score", "Comment", "Scribe's Comment", _
"M/F", "Foreign", "US", "Citizenship", "Area")
intNum = 0

'Set up sheet
With wsRep
.Activate
.AutoFilterMode = False
.Range("baseTable").CurrentRegion.Clear
.Range("baseTable").Resize(1, 11) = arr
End With

For Each sht In ActiveWorkbook.Sheets
Select Case sht.Name
Case "Instructions", "Summary", "Report", "base case"
'Do Nothing
Case Else
Rw = 1 + (120 * intNum)
' paste case name, first col
wsRep.Range("baseTable").Offset(Rw, 0).Resize(120, 1).Value = sht.Name

' paste student name, 1 cell over
wsSumm.Range("insertHere").Offset(8, 0).Resize(120, 1).Copy
wsRep.Range("baseTable").Offset(Rw, 1).PasteSpecial (xlPasteValues)

' paste cold call column, 2 cells over
sht.Range("B4:B123").Copy wsRep.Range("baseTable").Offset(Rw, 2)

' paste eval & comments cols, 3 cells over
sht.Range("E4:G123").Copy wsRep.Range("baseTable").Offset(Rw, 3)

' paste m/f, seating area
wsSumm.Range("insertHere").Offset(8, 6).Resize(120, 2).Copy
wsRep.Range("baseTable").Offset(Rw, 6).PasteSpecial (xlPasteValues)

intNum = intNum + 1
End Select
Next sht

wsRep.Range("baseTable").AutoFilter
DeleteEmptyRows

'add the formulas that were messed up when the rows were deleted
Range("Sum").Formula = "=SUBTOTAL(9,E10:E15000)"
Range("Average").Formula = "=SUBTOTAL(1,E10:E15000)"
Range("Count").Formula = "=SUBTOTAL(2,E10:E15000)"
Range("StdDev").Formula = "=SUBTOTAL(7,E10:E15000)"
End Sub
austenr
09-04-2007, 03:06 PM
Thanks Malcomb. Does this parse the
"Foreign", "US", "Citizenship", "Area" data as well?
mdmackillop
09-04-2007, 03:32 PM
It should do what it did before. No changes to the functionality.
austenr
09-04-2007, 06:44 PM
Not sure how to copy the US, Citizenship and area data to the report sheet.