Copying and Pasting Cells
Posted by CJ on May 30, 2001 11:19 AM
I am trying to insert a formula into the columns "PPOSAVINGS%", "PPOSAVINGS", and "PPOSTDREDUCT" and have it copied down to the last value. I have the formula inserted and copied down, but it copies all the way to the end of the worksheet. This is a report that will be run often, and the number of rows will vary each time. I am stumped as to how to find a way to get it to copy the formula just to the end of the data (I think for this data set it is like 1400 rows). ANy help is greatly appreciated!!! Thanks!
Private Sub cmdImport_Click()
Dim rec As Recordset
Dim rge As Range
Dim intRows As Integer
Dim intFields As Integer
Dim strSelect As String
Dim strConn As String
Dim db As Database
Dim wsp As Workspace
Dim stDocName1 As String
Dim lRow As Long
lRow = Range("B1").End(xlDown).Row
Call Clear_DataRange
Set wsp = DBEngine.Workspaces(0)
Set db = wsp.OpenDatabase("n:\PPORevenue1.mdb")
db.QueryTimeout = 15000
Set rge = Worksheets("RTF").Range("a7")
Set rec = db.OpenRecordset("Monthly All PPO Results by Processing Site")
rec.MoveLast
intRows = rec.RecordCount
rec.MoveFirst
intFields = rec.Fields.Count
'pastes field names
For intCount1 = 0 To intFields - 1 'do as many times as there are fields
rge.Cells(1, intCount1 + 1).Value = rec.Fields(intCount1).Name
Next intCount1
'pastes field values
For intcount2 = 0 To intRows - 1 'do this as many times as there are rows
For intcount3 = 0 To intFields - 1 'do this as many times as there are fields
rge.Cells(intcount2 + 2, intcount3 + 1).Value = rec.Fields(intcount3).Value
Next intcount3
rec.MoveNext
Next intcount2
'Insert blank columns
Columns("I:K").EntireColumn.Insert
[K7] = "PPOSAVINGS%"
[J7] = "PPOSAVINGS"
[I7] = "PPOSTDREDUCT"
Range("B8").EntireColumn.Insert
'Insert values into columns
Range("J8:J" & Range("B65536").End(xlDown).Row).Formula = "=RC[-1]-RC[3]"
rec.Close
'Format width of columns and add border around titles
Range("A:Z").Columns.AutoFit 'starting and ending cell in ()
'With Worksheets("RTF")
'.Range(.Cells(7, 1), .Cells(7, 7)).Borders.Weight = xlThin
'End With
db.Close
End Sub