Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

vba trouble copying values only from one wrkbk to another 1

Status
Not open for further replies.

langer1

Technical User
May 28, 2003
4
0
0
IE
I'm having a little trouble with the following program. The program collects a fixed range from several sheets in a workbook, copies all of these ranges and pastes them one after another on one worksheet in a new (Destination) workbook. The problem is that all of the cells within a range contain fomulas. I want to paste the values only. I am aware of the pastespecial functions but every time i try to modify it i get a error saying out of range. I will show you the program which works but copies the formulas and the values to the destination. I would be very greatful if anyone there could modify the code so that the destination workbook shows only the values.
Regards Carl

------------------------------------------------------------
Sub PierCarl()
Dim SheetNames() As String
Dim SheetCount As Integer
Dim i As Integer

SheetCount = ActiveWorkbook.Sheets.Count 'count the number of sheets
ReDim SheetNames(1 To SheetCount)

'Put a value to each sheets

For i = 2 To SheetCount
SheetNames(i) = ActiveWorkbook.Sheets(i).Name
Next i

'Paste each values one after the other for every sheets in sheet1
'The offset set the start to put values (row,column)

For i = 2 To SheetCount

'these are the 2 lines where im having the most grief!
ActiveWorkbook.Sheets(SheetNames(i)).Range("F23:S39").Copy _
Destination:=Worksheets("Sheet1").[A65336].End(xlUp).Offset(0, 0)

Next i

End Sub
------------------------------------------------------------
Sub GetAllWorkSheets()
'Gets all worksheets from selected files and adds
'them to the activeworkbook

Dim varFile As Variant
Dim strFile As Variant
Dim shtData As Variant
Dim wkbData As Workbook
Dim wkbCurrent As Workbook
Dim i As Integer

'set refernce to current workbook
Set wkbCurrent = ActiveWorkbook

'display open file dialog box to user
varFile = Application.GetOpenFilename(MultiSelect:=True)

i = 1
'loop through all files selected
For Each strFile In varFile
Set wkbData = Workbooks.Open(strFile)
'loop through all sheets in file
For Each shtData In ActiveWorkbook.Sheets
'copy sheet to orginal workbook
shtData.Copy After:=wkbCurrent.Sheets(wkbCurrent.Sheets.Count)
Next
'close file
wkbData.Close SaveChanges:=False
Next
End Sub
------------------------------------------------------------
 
When in the VBA IDE, click the "Help" button and do a search on "PasteSpecial." There is lots of info and examples in the Help Section on using the .PasteSpecial method.
 
Here is some code that does the trick - a few pointers:

1. Where a method requires range objects for arguments it is always safer to explicitly define the range objects - it will be immediately apparent if there is something wrong with a range

2. Use the "for each [object] in [collection]" construct wherever possible - it is much easier and more compact

3. The rng.end(xldown ot xlup) will always go to an occupied cell - if you want to write in the next cell then you need an offset(1,0)

Anyway - here is the code - hope it helps and have a good weekend!

Sub CopyData()

Dim wb As Workbook
Dim sht As Worksheet
Dim rngDest As Range
Dim rngCopy As Range
Dim fDoneFirst As Boolean
On Error GoTo ProcError

'initialise first flag
fDoneFirst = False

'intialise destination range and set wb
Set wb = ActiveWorkbook
Set rngDest = wb.Sheets(1).Cells(1, 1)

'for each sheet in this workbook apart from the first
For Each sht In wb.Worksheets
If fDoneFirst = False Then
fDoneFirst = True
Else
'define range to copy
Set rngCopy = sht.Range("F23:S39")
'copy defined range
rngCopy.Copy
'paste copied range
rngDest.PasteSpecial xlPasteValues
'reset destination range to one cell below currentregion
Set rngDest = rngDest.End(xlDown).Offset(1, 0)

End If
Next sht
wb.Sheets(1).Cells(1, 1).Select
'clean up
Set wb = Nothing
Set rngCopy = Nothing
Set rngDest = Nothing
Set sht = Nothing

ProcExit:
Exit Sub
ProcError:
MsgBox Error(Err)
Resume 'ProcExit


End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top