Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Hi,
Bear with me, first time poster, not very Excel-minded! I have a macro (which I didn't write) that extracts information from several Excel worksheets and complies it into one large summary worksheet. (Basically the same thing as copying and pasting all the data by hand.) The problem is that the macro should just copy and paste the data directly into the summary spreadsheet. Instead it seems to be pasting links or references rather that just data. So, instead of generating a summary worksheet with numbers/raw data, it generates the worksheet filled with REF! errors. Is there a way to change preferences to tell Excel to always paste values instead of links? Also, this only seems to be a problem with Excel 2000. It seems to run fine with Excel 98. Thanks! Meg --- Message posted from http://www.ExcelForum.com/ |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
ok, thanks!
Here's the code (sorry it's so long, I had to cut off a little of the end): Sub grab1() ' ' grab1 Macro ' Macro recorded 3/26/02 by alex Dim CurrFile As String Dim wb As Workbook Dim revComm As String Dim currentData As String Dim newBook As Workbook Dim directory As String Set wb = ActiveWorkbook directory = wb.Path Set newBook = Workbooks.Add newBook.Activate Range("a1").Select ActiveCell.Value = "Patient" Range("b1").Select ActiveCell.Value = "DOB" Range("c1").Select ActiveCell.Value = "Record Date" Range("D1").Select ActiveCell.Value = "Sex" Range("E1").Select ActiveCell.Value = "PSG file" Range("F1").Select ActiveCell.Value = "SCO file" Range("G1").Select ActiveCell.Value = "Rec. Start" Range("H1").Select ActiveCell.Value = "Rec. Time" Range("I1").Select ActiveCell.Value = "# Epochs" Range("J1").Select ActiveCell.Value = "Lights-Out" Range("K1").Select ActiveCell.Value = "Lights-On" Range("L1").Select ActiveCell.Value = "Comments" Range("M1").Select ActiveCell.Value = "spreadsheet" destinationColumn = ActiveCell.Column wb.Activate ' Sleep summary, unfolded For dataRow = 1 To 11 Set currentCell = Cells(65 + dataRow, 1) currentCell.Select dLabel = ActiveCell.Value For dataCol = 1 To 5 Set currentCell = Cells(65, 4 + dataCol) currentCell.Select unitLabel = ActiveCell.Value newBook.Activate destinationColumn = destinationColumn + 1 Set currentCell = Cells(1, destinationColumn) currentCell.Select ActiveCell.Value = dLabel & " - " & unitLabel wb.Activate Next Next ' Latencies table, unfolded For dataRow = 1 To 8 Set currentCell = Cells(84 + dataRow, 1) currentCell.Select dLabel = ActiveCell.Value For dataCol = 1 To 4 Set currentCell = Cells(84, 4 + dataCol) currentCell.Select unitLabel = ActiveCell.Value newBook.Activate destinationColumn = destinationColumn + 1 Set currentCell = Cells(1, destinationColumn) currentCell.Select ActiveCell.Value = dLabel & " - " & unitLabel wb.Activate Next Next ' Arousals table, unfolded For dataRow = 1 To 7 Set currentCell = Cells(94 + dataRow, 1) currentCell.Select dLabel = ActiveCell.Value For dataCol = 1 To 3 Set currentCell = Cells(94, 4 + dataCol) currentCell.Select unitLabel = ActiveCell.Value newBook.Activate destinationColumn = destinationColumn + 1 Set currentCell = Cells(1, destinationColumn) currentCell.Select ActiveCell.Value = dLabel & " - " & unitLabel wb.Activate Next Next wb.Close ' On windows, use the FileSearch object. ' With Application.FileSearch ' .NewSearch ' .LookIn = folder path ' if .Execute() 0 Then ' For i = 1 to .FoundFiles.Count ' currfile = .FoundFiles(i) ' Next i ' Else ' MsgBox "No files found in " & folderpath ' End If With Application.FileSearch ..NewSearch ..LookIn = directory ..FileName = ".XLS" If .Execute <= 0 Then MsgBox "No files found in " & directory End If With .FoundFiles For i = 1 To .Count CurrFile = .Item(i) Set wb = Workbooks.Open(CurrFile) wb.Activate Range("C5").Select Selection.Copy newBook.Activate Rows("2:2").Select Application.CutCopyMode = False Selection.Insert Shift:=xlDown Range("A2").Select wb.Activate Range("C5").Select Selection.Copy newBook.Activate ActiveSheet.Paste wb.Activate ' date of birth Range("C7").Select Selection.Copy newBook.Activate Range("B2").Select ActiveSheet.Paste ' get recording date wb.Activate Range("C10").Select currentData = ActiveCell.Value newBook.Activate Range("C2").Select ActiveCell.Value = currentData ' date conversions ' Range("C2").Select ' ActiveCell.FormulaR1C1 = "=datevalue(SUBSTITUTE(RC[-1], " & Chr(34) & "Test Date: " & Chr(34) & ", " & Chr(34) & Chr(34) & "))" ' Selection.NumberFormat = "mmmm d, yyyy" ' sex wb.Activate Range("G5").Select Selection.Copy newBook.Activate Range("D2").Select ActiveSheet.Paste ' PSG file name wb.Activate Range("C13").Select Selection.Copy newBook.Activate Range("E2").Select ActiveSheet.Paste ' SCO file name wb.Activate Range("C14").Select Selection.Copy newBook.Activate Range("F2").Select ActiveSheet.Paste ' recording start time wb.Activate Range("C17").Select Selection.Copy newBook.Activate Range("G2").Select ActiveSheet.Paste ' recording time in minutes wb.Activate Range("C18").Select Selection.Copy newBook.Activate Range("H2").Select ActiveSheet.Paste ' total number of epochs wb.Activate Range("C19").Select Selection.Copy newBook.Activate Range("I2").Select ActiveSheet.Paste ' lights out time wb.Activate Range("G17").Select Selection.Copy newBook.Activate Range("J2").Select ActiveSheet.Paste ' lights on time wb.Activate Range("G18").Select Selection.Copy newBook.Activate Range("K2").Select ActiveSheet.Paste ' reviewer's comments wb.Activate Range("K63").Select If (ActiveCell.Value < "") Then revComm = ActiveCell.Value revComm = Trim(revComm) newBook.Activate Range("L2").Select ActiveCell.Value = revComm End If ' name of original spreadsheet newBook.Activate Range("M2").Select ActiveCell.Value = Mid(CurrFile, InStr(CurrFile, ":") + 1) destinationColumn = ActiveCell.Column ' Sleep summary, unfolded For dataRow = 1 To 11 For dataCol = 1 To 5 wb.Activate Set currentCell = Cells(65 + dataRow, 4 + dataCol) currentCell.Select Selection.Copy newBook.Activate destinationColumn = destinationColumn + 1 Set currentCell = Cells(2, destinationColumn) currentCell.Select ActiveSheet.Paste Next Next ' Latencies table, unfolded For dataRow = 1 To 8 For dataCol = 1 To 4 wb.Activate Set currentCell = Cells(84 + dataRow, 4 + dataCol) currentCell.Select Selection.Copy newBook.Activate destinationColumn = destinationColumn + 1 Set currentCell = Cells(2, destinationColumn) currentCell.Select ActiveSheet.Paste Next Next ' Arousals table, unfolded For dataRow = 1 To 7 For dataCol = 1 To 3 wb.Activate Set currentCell = Cells(94 + dataRow, 4 + dataCol) currentCell.Select currentData = ActiveCell.Value newBook.Activate destinationColumn = destinationColumn + 1 Set currentCell = Cells(2, destinationColumn) currentCell.Select ActiveCell.Value = currentData Next Next wb.Close Next i End With End With --- Message posted from http://www.ExcelForum.com/ |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Meg,
I can't figure out what you are trying to do. However, I can give you a couple of things to try. Get rid of all the unnecessary selections that you can. from this Range("a1").Select ActiveCell.Value = "Patient" to this Range("a1")= "Patient" === I can't figure this out. For dataRow = 1 To 11 Set currentCell = Cells(65 + dataRow, 1) currentCell.Select dLabel = ActiveCell.Value next ======= ' date of birth Range("C7").Select Selection.Copy newBook.Activate Range("B2").Select ActiveSheet.Paste could probably be to eliminate all the going back & forth ' date of birth newBook.sheets("Sheet1").range("b2")=wb.sheets("Wh atSheet").range("c7") ========= -- Don Guillett SalesAid Software "Meg" wrote in message ... ok, thanks! Here's the code (sorry it's so long, I had to cut off a little of the end): Sub grab1() ' ' grab1 Macro ' Macro recorded 3/26/02 by alex Dim CurrFile As String Dim wb As Workbook Dim revComm As String Dim currentData As String Dim newBook As Workbook Dim directory As String Set wb = ActiveWorkbook directory = wb.Path Set newBook = Workbooks.Add newBook.Activate Range("a1").Select ActiveCell.Value = "Patient" Range("b1").Select ActiveCell.Value = "DOB" Range("c1").Select ActiveCell.Value = "Record Date" Range("D1").Select ActiveCell.Value = "Sex" Range("E1").Select ActiveCell.Value = "PSG file" Range("F1").Select ActiveCell.Value = "SCO file" Range("G1").Select ActiveCell.Value = "Rec. Start" Range("H1").Select ActiveCell.Value = "Rec. Time" Range("I1").Select ActiveCell.Value = "# Epochs" Range("J1").Select ActiveCell.Value = "Lights-Out" Range("K1").Select ActiveCell.Value = "Lights-On" Range("L1").Select ActiveCell.Value = "Comments" Range("M1").Select ActiveCell.Value = "spreadsheet" destinationColumn = ActiveCell.Column wb.Activate ' Sleep summary, unfolded For dataRow = 1 To 11 Set currentCell = Cells(65 + dataRow, 1) currentCell.Select dLabel = ActiveCell.Value For dataCol = 1 To 5 Set currentCell = Cells(65, 4 + dataCol) currentCell.Select unitLabel = ActiveCell.Value newBook.Activate destinationColumn = destinationColumn + 1 Set currentCell = Cells(1, destinationColumn) currentCell.Select ActiveCell.Value = dLabel & " - " & unitLabel wb.Activate Next Next ' Latencies table, unfolded For dataRow = 1 To 8 Set currentCell = Cells(84 + dataRow, 1) currentCell.Select dLabel = ActiveCell.Value For dataCol = 1 To 4 Set currentCell = Cells(84, 4 + dataCol) currentCell.Select unitLabel = ActiveCell.Value newBook.Activate destinationColumn = destinationColumn + 1 Set currentCell = Cells(1, destinationColumn) currentCell.Select ActiveCell.Value = dLabel & " - " & unitLabel wb.Activate Next Next ' Arousals table, unfolded For dataRow = 1 To 7 Set currentCell = Cells(94 + dataRow, 1) currentCell.Select dLabel = ActiveCell.Value For dataCol = 1 To 3 Set currentCell = Cells(94, 4 + dataCol) currentCell.Select unitLabel = ActiveCell.Value newBook.Activate destinationColumn = destinationColumn + 1 Set currentCell = Cells(1, destinationColumn) currentCell.Select ActiveCell.Value = dLabel & " - " & unitLabel wb.Activate Next Next wb.Close ' On windows, use the FileSearch object. ' With Application.FileSearch ' .NewSearch ' .LookIn = folder path ' if .Execute() 0 Then ' For i = 1 to .FoundFiles.Count ' currfile = .FoundFiles(i) ' Next i ' Else ' MsgBox "No files found in " & folderpath ' End If With Application.FileSearch NewSearch LookIn = directory FileName = ".XLS" If .Execute <= 0 Then MsgBox "No files found in " & directory End If With .FoundFiles For i = 1 To .Count CurrFile = .Item(i) Set wb = Workbooks.Open(CurrFile) wb.Activate Range("C5").Select Selection.Copy newBook.Activate Rows("2:2").Select Application.CutCopyMode = False Selection.Insert Shift:=xlDown Range("A2").Select wb.Activate Range("C5").Select Selection.Copy newBook.Activate ActiveSheet.Paste wb.Activate ' date of birth Range("C7").Select Selection.Copy newBook.Activate Range("B2").Select ActiveSheet.Paste ' get recording date wb.Activate Range("C10").Select currentData = ActiveCell.Value newBook.Activate Range("C2").Select ActiveCell.Value = currentData ' date conversions ' Range("C2").Select ' ActiveCell.FormulaR1C1 = "=datevalue(SUBSTITUTE(RC[-1], " & Chr(34) & "Test Date: " & Chr(34) & ", " & Chr(34) & Chr(34) & "))" ' Selection.NumberFormat = "mmmm d, yyyy" ' sex wb.Activate Range("G5").Select Selection.Copy newBook.Activate Range("D2").Select ActiveSheet.Paste ' PSG file name wb.Activate Range("C13").Select Selection.Copy newBook.Activate Range("E2").Select ActiveSheet.Paste ' SCO file name wb.Activate Range("C14").Select Selection.Copy newBook.Activate Range("F2").Select ActiveSheet.Paste ' recording start time wb.Activate Range("C17").Select Selection.Copy newBook.Activate Range("G2").Select ActiveSheet.Paste ' recording time in minutes wb.Activate Range("C18").Select Selection.Copy newBook.Activate Range("H2").Select ActiveSheet.Paste ' total number of epochs wb.Activate Range("C19").Select Selection.Copy newBook.Activate Range("I2").Select ActiveSheet.Paste ' lights out time wb.Activate Range("G17").Select Selection.Copy newBook.Activate Range("J2").Select ActiveSheet.Paste ' lights on time wb.Activate Range("G18").Select Selection.Copy newBook.Activate Range("K2").Select ActiveSheet.Paste ' reviewer's comments wb.Activate Range("K63").Select If (ActiveCell.Value < "") Then revComm = ActiveCell.Value revComm = Trim(revComm) newBook.Activate Range("L2").Select ActiveCell.Value = revComm End If ' name of original spreadsheet newBook.Activate Range("M2").Select ActiveCell.Value = Mid(CurrFile, InStr(CurrFile, ":") + 1) destinationColumn = ActiveCell.Column ' Sleep summary, unfolded For dataRow = 1 To 11 For dataCol = 1 To 5 wb.Activate Set currentCell = Cells(65 + dataRow, 4 + dataCol) currentCell.Select Selection.Copy newBook.Activate destinationColumn = destinationColumn + 1 Set currentCell = Cells(2, destinationColumn) currentCell.Select ActiveSheet.Paste Next Next ' Latencies table, unfolded For dataRow = 1 To 8 For dataCol = 1 To 4 wb.Activate Set currentCell = Cells(84 + dataRow, 4 + dataCol) currentCell.Select Selection.Copy newBook.Activate destinationColumn = destinationColumn + 1 Set currentCell = Cells(2, destinationColumn) currentCell.Select ActiveSheet.Paste Next Next ' Arousals table, unfolded For dataRow = 1 To 7 For dataCol = 1 To 3 wb.Activate Set currentCell = Cells(94 + dataRow, 4 + dataCol) currentCell.Select currentData = ActiveCell.Value newBook.Activate destinationColumn = destinationColumn + 1 Set currentCell = Cells(2, destinationColumn) currentCell.Select ActiveCell.Value = currentData Next Next wb.Close Next i End With End With --- Message posted from http://www.ExcelForum.com/ |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
command button that copies and pastes from one list box to another | Excel Discussion (Misc queries) | |||
A Macro that Copies from Excel & Pastes into a webpage | Excel Discussion (Misc queries) | |||
Excel macro that opens new MS Word file and pastes data as a pictu | Excel Worksheet Functions | |||
Copies 02/22/2005, Pastes 02/21/2001 | Excel Worksheet Functions | |||
Macro that copies values | Excel Programming |