Copy paste formulas when running multiple instances of excel

P

Poniente

Hi all,
I'm running separate instances of Excel 2003 to make better use of
processor power. Each of 3 instances of Excel runs a simulation. Every
now and then this process fails because of interfering copy paste
commands which are somehow get mixed up across the multiple instances
of excel.

I'm already using the range(a).value = range(b).value copy methode for
values.

Can anyone help me find a similar methode for 1) formulas and 2) all
formats, without using the troublesome pastespecial?

Ad 1) formulas:
I tried:
Range("C1:C10").Formula = Range("A1:A10").Formula
doesn't work, as it does not retain the dynamic nature of some of the
references in the formulas..
I also tried
Range("A1:C10").Formula = Range("A1:A10").Formula
which does work, but overwrites B1:B10, and I can't have that..


Regards,
Poniente

http://groups.google.nl/group/micro...stances+of+excel+copy+paste+#2379a1d63d284bb5
 
J

Joel

I'm not sure whatt is troublesome with pastespecial. You can use just a
straight copy. Becuase you are using VALUE only the value gets copied and
not the formats or formulas.

range(b).copy destination:=range(a)
 
P

Poniente

For whomever may be interested, the code below seems to work, although
I agree its not a beauty..


Sub PasteFormulas(CopyOriginal As Range, PasteOriginal As Range)

Dim CopyR As Range
Dim PasteR As Range
Dim PasteTemp As Range

Dim Counter As Long
Dim CopyRCells As Long
Dim PasteRCells As Long
Dim CopyRRows As Long
Dim CopyRCols As Long
Dim PasteRRows As Long
Dim PasteRCols As Long

Dim SSh As Worksheet
Dim TSh As Worksheet


Set CopyR = CopyOriginal
Set PasteR = PasteOriginal
CopyRCells = CopyOriginal.Cells.Count
PasteRCells = PasteOriginal.Cells.Count
CopyRRows = CopyOriginal.Rows.Count
CopyRCols = CopyOriginal.Columns.Count
PasteRRows = PasteOriginal.Rows.Count
PasteRCols = PasteOriginal.Columns.Count


' check if or cols or rows are 1
If CopyRRows > 1 And CopyRCols > 1 Then
MsgBox "For PasteFormulas vba, Copy range should either be 1
column or 1 row"
Exit Sub
End If

Dim WbOrg As String
Dim WbCP As String


Select Case CopyRRows

Case 1
' horizontal source
If PasteRCols <> CopyRCols Then
MsgBox "Pasted cols <> to Copied cols"
Exit Sub
End If
If CopyR.Cells(1).Column <= PasteR.Cells(1).Column Then
' copy left of paste

If CopyR.Cells(1).Row <= PasteR.Cells(PasteRCells).Row Then
' copy above paste
WbOrg = ActiveWorkbook.Name
Workbooks.Add
WbCP = ActiveWorkbook.Name
Set CopyR = Range("'[" & WbCP & "]Sheet1'!" &
CopyOriginal.Address)
Set PasteR = Range("'[" & WbCP & "]Sheet1'!" &
PasteOriginal.Address)
CopyR.Formula = CopyOriginal.Formula
Counter = 1
Do While Counter <= CopyRCols
Set PasteTemp = Range(CopyR.Cells(CopyRCells - Counter
+ 1).Address, _
PasteR.Cells(PasteRCells - Counter + 1).Address)

PasteTemp.Formula = CopyR.Cells(CopyRCells - Counter +
1).Formula
Counter = Counter + 1
Loop
PasteOriginal.Formula = PasteR.Formula
Windows(WbCP).Close savechanges:=False
End If

Set CopyR = CopyOriginal
Set PasteR = PasteOriginal
CopyRCells = CopyOriginal.Cells.Count
PasteRCells = PasteOriginal.Cells.Count
CopyRRows = CopyOriginal.Rows.Count
CopyRCols = CopyOriginal.Columns.Count
PasteRRows = PasteOriginal.Rows.Count
PasteRCols = PasteOriginal.Columns.Count

If CopyR.Cells(1).Row > PasteR.Cells(1).Row Then
' copy below paste
WbOrg = ActiveWorkbook.Name
Workbooks.Add
WbCP = ActiveWorkbook.Name
Set CopyR = Range("'[" & WbCP & "]Sheet1'!" &
CopyOriginal.Address)
Set PasteR = Range("'[" & WbCP & "]Sheet1'!" &
PasteOriginal.Address)
CopyR.Formula = CopyOriginal.Formula
Counter = 1
Do While Counter <= CopyRCols
Set PasteTemp = Range(CopyR.Cells(CopyRCells - Counter
+ 1).Address, _
PasteR.Cells(PasteRCols - Counter + 1).Address)

PasteTemp.Formula = CopyR.Cells(CopyRCells - Counter +
1).Formula
Counter = Counter + 1
Loop
PasteOriginal.Resize(Application.WorksheetFunction.Min
(PasteRRows, CopyR.Cells(1).Row - PasteR.Cells(1).Row),
PasteRCols).Formula = PasteR.Formula
Windows(WbCP).Close savechanges:=False
End If
End If
Set CopyR = CopyOriginal
Set PasteR = PasteOriginal
CopyRCells = CopyOriginal.Cells.Count
PasteRCells = PasteOriginal.Cells.Count
CopyRRows = CopyOriginal.Rows.Count
CopyRCols = CopyOriginal.Columns.Count
PasteRRows = PasteOriginal.Rows.Count
PasteRCols = PasteOriginal.Columns.Count
If CopyR.Cells(1).Column > PasteR.Cells(1).Column Then
' copy right of paste

If CopyR.Cells(1).Row <= PasteR.Cells(PasteRCells).Row Then
' copy above paste
Counter = 1
WbOrg = ActiveWorkbook.Name
Workbooks.Add
WbCP = ActiveWorkbook.Name
Set CopyR = Range("'[" & WbCP & "]Sheet1'!" &
CopyOriginal.Address)
Set PasteR = Range("'[" & WbCP & "]Sheet1'!" &
PasteOriginal.Address)
CopyR.Formula = CopyOriginal.Formula
Do While Counter <= CopyRCols
Set PasteTemp = Range(CopyR.Cells(Counter).Address, _
PasteR.Cells(PasteRCells - PasteRCols +
Counter).Address)

PasteTemp.Formula = CopyR.Cells(Counter).Formula
Counter = Counter + 1
Loop
' PasteOriginal.Resize(Application.WorksheetFunction.Min
(PasteRRows, CopyR.Cells(1).Row - PasteR.Cells(1).Row),
PasteRCols).Formula = PasteR.Formula
PasteOriginal.Formula = PasteR.Formula
Windows(WbCP).Close savechanges:=False
End If


Set CopyR = CopyOriginal
Set PasteR = PasteOriginal
CopyRCells = CopyOriginal.Cells.Count
PasteRCells = PasteOriginal.Cells.Count
CopyRRows = CopyOriginal.Rows.Count
CopyRCols = CopyOriginal.Columns.Count
PasteRRows = PasteOriginal.Rows.Count
PasteRCols = PasteOriginal.Columns.Count

If CopyR.Cells(1).Row > PasteR.Cells(1).Row Then
' copy below paste
Counter = 1
WbOrg = ActiveWorkbook.Name
Workbooks.Add
WbCP = ActiveWorkbook.Name
Set CopyR = Range("'[" & WbCP & "]Sheet1'!" &
CopyOriginal.Address)
Set PasteR = Range("'[" & WbCP & "]Sheet1'!" &
PasteOriginal.Address)
CopyR.Formula = CopyOriginal.Formula
Do While Counter <= CopyRCols
Set PasteTemp = Range(CopyR.Cells(Counter).Address, _
PasteR.Cells(Counter).Address)

PasteTemp.Formula = CopyR.Cells(Counter).Formula
Counter = Counter + 1
Loop
Dim TestInt As Long
PasteOriginal.Resize(Application.WorksheetFunction.Min
(PasteRRows, CopyR.Cells(1).Row - PasteR.Cells(1).Row),
PasteRCols).Formula = PasteR.Formula
Windows(WbCP).Close savechanges:=False
End If

End If

Case Else
' vertical source
If PasteRRows <> CopyRRows Then
MsgBox "Pasted rows <> to Copied rows"
Exit Sub
End If

If CopyR.Cells(1).Row <= PasteR.Cells(1).Row Then
' copy above paste
If CopyR.Cells(1).Column <= PasteR.Cells(PasteRCells).Column
Then
' copy is left of or at paste


Counter = 1
WbOrg = ActiveWorkbook.Name
Workbooks.Add
WbCP = ActiveWorkbook.Name
Set CopyR = Range("'[" & WbCP & "]Sheet1'!" &
CopyOriginal.Address)
Set PasteR = Range("'[" & WbCP & "]Sheet1'!" &
PasteOriginal.Address)
CopyR.Formula = CopyOriginal.Formula
Do While Counter <= CopyRCells
Set PasteTemp = Range(CopyR.Cells(CopyRCells - Counter
+ 1).Address, _
PasteR.Cells(PasteRCells - (Counter - 1) *
PasteRCols).Address)

PasteTemp.Formula = CopyR.Cells(CopyRCells - Counter +
1).Formula
Counter = Counter + 1
Loop
PasteOriginal.Formula = PasteR.Formula
Windows(WbCP).Close savechanges:=False
End If


Set CopyR = CopyOriginal
Set PasteR = PasteOriginal
CopyRCells = CopyOriginal.Cells.Count
PasteRCells = PasteOriginal.Cells.Count
CopyRRows = CopyOriginal.Rows.Count
CopyRCols = CopyOriginal.Columns.Count
PasteRRows = PasteOriginal.Rows.Count
PasteRCols = PasteOriginal.Columns.Count

If CopyR.Cells(1).Column > PasteR.Cells(1).Column Then
' copy is right of paste
' only changes set PasteTemp

Counter = 1
WbOrg = ActiveWorkbook.Name
Workbooks.Add
WbCP = ActiveWorkbook.Name
Set CopyR = Range("'[" & WbCP & "]Sheet1'!" &
CopyOriginal.Address)
Set PasteR = Range("'[" & WbCP & "]Sheet1'!" &
PasteOriginal.Address)
CopyR.Formula = CopyOriginal.Formula
Do While Counter <= CopyRCells
Set PasteTemp = Range(CopyR.Cells(CopyRCells - Counter
+ 1).Address, _
PasteR.Cells(PasteRCells - (Counter - 1) * PasteRCols
- PasteRCols + 1).Address)

PasteTemp.Formula = CopyR.Cells(CopyRCells - Counter +
1).Formula
Counter = Counter + 1
Loop
PasteOriginal.Resize(PasteRRows,
Application.WorksheetFunction.Min(PasteRCols, CopyR.Cells(1).Column -
PasteR.Cells(1).Column)).Formula = PasteR.Formula
Windows(WbCP).Close savechanges:=False
End If
Else
' copy below paste
' copy is left of or at paste
If CopyR.Cells(1).Column <= PasteR.Cells(PasteRCells).Column
Then
Counter = CopyRCells
WbOrg = ActiveWorkbook.Name
Workbooks.Add
WbCP = ActiveWorkbook.Name
Set CopyR = Range("'[" & WbCP & "]Sheet1'!" &
CopyOriginal.Address)
Set PasteR = Range("'[" & WbCP & "]Sheet1'!" &
PasteOriginal.Address)
CopyR.Formula = CopyOriginal.Formula
Do While Counter >= 1
Set PasteTemp = Range(CopyR.Cells(CopyRCells - Counter
+ 1).Address, _
PasteR.Cells(PasteRCells - (Counter - 1) *
PasteRCols).Address)

PasteTemp.Formula = CopyR.Cells(CopyRCells - Counter +
1).Formula
Counter = Counter - 1
Loop
PasteOriginal.Formula = PasteR.Formula
Windows(WbCP).Close savechanges:=False
End If
' copy is right of paste
' only changes set PasteTemp


Set CopyR = CopyOriginal
Set PasteR = PasteOriginal
CopyRCells = CopyOriginal.Cells.Count
PasteRCells = PasteOriginal.Cells.Count
CopyRRows = CopyOriginal.Rows.Count
CopyRCols = CopyOriginal.Columns.Count
PasteRRows = PasteOriginal.Rows.Count
PasteRCols = PasteOriginal.Columns.Count

If CopyR.Cells(1).Column > PasteR.Cells(1).Column Then
Counter = CopyRCells
WbOrg = ActiveWorkbook.Name
Workbooks.Add
WbCP = ActiveWorkbook.Name
Set CopyR = Range("'[" & WbCP & "]Sheet1'!" &
CopyOriginal.Address)
Set PasteR = Range("'[" & WbCP & "]Sheet1'!" &
PasteOriginal.Address)
CopyR.Formula = CopyOriginal.Formula
Do While Counter >= 1
Set PasteTemp = Range(CopyR.Cells(CopyRCells - Counter
+ 1).Address, _
PasteR.Cells(PasteRCells - (Counter - 1) * PasteRCols
- PasteRCols + 1).Address)

PasteTemp.Formula = CopyR.Cells(CopyRCells - Counter +
1).Formula
Counter = Counter - 1
Loop
PasteOriginal.Resize(PasteRRows,
Application.WorksheetFunction.Min(PasteRCols, CopyR.Cells(1).Column -
PasteR.Cells(1).Column)).Formula = PasteR.Formula
Windows(WbCP).Close savechanges:=False

End If
End If

End Select


End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

'.Copy Destination:=' temporarily freezes multiple instances in Excel 2010 2
copy then paste to multiple ranges 3
Copy and Paste exact formula 5
Find Multiple Values, Copy Entire Row & Paste 10
The easiest way to copy a sheet of formulas! (Excel 2007) 1
While doing multiple cell copy paste the Selection.PasteSpecial overrides the protected formula cell 1
Code to copy the last row formulas and paste it in the bottom row 3
Automating copy/paste/paste special when row references change 4

Top