change a macro so that it copies and pastes data as values rather than references

  • Thread starter Thread starter Meg
  • Start date Start date
M

Meg

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
 
As usual, you should copy/paste your code for evaluation. It's good that you
told us the xl versions.
 
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
 
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"
Click to expand...
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
Click to expand...

could probably be to eliminate all the going back & forth
' date of birth
Click to expand...
newBook.sheets("Sheet1").range("b2")=wb.sheets("WhatSheet").range("c7")
=========

--
Don Guillett
SalesAid Software
(e-mail address removed)
Meg said:
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
Click to expand...
 
Back
Top