Cyclops755
New Member
- Joined
- Jul 26, 2011
- Messages
- 31
The workbook I'm working on contains the following code to export data from two tables on two separate sheets, and combine them on one sheet so that it can be referenced to a PVT. The code works wonderfully, but I've recently had to make a few changes to the workbook, and the way the code runs now, it exports the formulas associated with all the cells to the new sheet. How can I tweak this to export just the values to the new sheet?
Thanks a bunch!
Thanks a bunch!
Code:
Option Explicit
Sub CreateDataStorageNoDelete()
Dim myLastM, myCountM, i1, j1, cr, LastRow1, LastCol1, LastRow2, LastCol2, LastRow3, LastCol3 As Long
Dim myFormula1, myFormula2 As String
Dim myST(1 To 3) As Object
'Declare sheets to be used as variables
Set myST(1) = Sheets("Parts List")
Set myST(2) = Sheets("Combine Build List")
Set myST(3) = Sheets("Data Storage")
Application.ScreenUpdating = False
'Make destination sheet visable
Sheets("Data Storage").Visible = True
'Define the range on which Parts data exists
LastCol1 = myST(1).Cells(1, Columns.Count).End(xlToLeft).Column
LastRow1 = WorksheetFunction.Match("zzzzz", myST(1).Range("A:A"))
myST(2).Select
ActiveSheet.Unprotect ("Combine")
LastCol2 = Cells(1, Columns.Count).End(xlToLeft).Column + 1
LastRow2 = WorksheetFunction.Match("zzzzz", Range("A:A"))
myLastM = 2 * LastCol2
myFormula1 = "=IF(COLUMNS(C2:C[-" & (LastCol2 - 1) & "])>COUNTIF(RC2:RC" & LastCol2 & ",""a""),"""",INDEX(R1C2:R1C" & LastCol2 & _
",,LARGE((RC2:RC" & LastCol2 & "=""a"")*(COLUMN(R1C2:R1C" & LastCol2 & ")-COLUMN(R1C2)+1),COLUMNS(C2:C[-" & (LastCol2 - 1) & "]))))"
Cells(2, LastCol2 + 1).FormulaArray = myFormula1
Cells(2, LastCol2 + 1).Copy Destination:=Range(Cells(2, LastCol2 + 2), Cells(2, myLastM))
Range(Cells(2, LastCol2 + 1), Cells(2, myLastM)).Copy Destination:=Range(Cells(3, LastCol2 + 1), Cells(LastRow2, myLastM))
Range(Cells(2, myLastM + 1), Cells(LastRow2, myLastM + 1)).FormulaR1C1 = "=COUNTIF(RC2:RC" & LastCol2 & ",""a"")"
'ActiveSheet.Protect ("Combine")
myST(3).Select
LastCol3 = Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(1, 1).Value = "" Then
LastRow3 = 1
Else
LastRow3 = WorksheetFunction.Match("zzzzz", Range("A:A"))
End If
Range(Cells(1, 1), Cells(LastRow3, LastCol3)).ClearContents
myST(1).Range(Cells(1, 1).Address, Cells(1, LastCol1).Address).Copy
Cells(1, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Cells(1, LastCol1 + 1).Value = "Machine"
Application.Calculation = xlCalculationManual
cr = 2
For i1 = 2 To LastRow1
Application.StatusBar = "Processing row " & i1 & " de " & LastRow1
myST(2).Range(Cells(i1, LastCol2 + 1).Address, Cells(i1, myLastM).Address).Copy
Cells(cr, LastCol1 + 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
myCountM = myST(2).Cells(i1, myLastM + 1).Value
myCountM = IIf(myCountM = 0, 1, myCountM)
myST(1).Range(Cells(i1, 1).Address, Cells(i1, LastCol1).Address).Copy Destination:=Range(Cells(cr, 1), Cells(cr + myCountM - 1, LastCol1))
cr = cr + myCountM
Next i1
Range(Cells(1, 1), Cells(1, LastCol1 + 1)).EntireColumn.AutoFit
Sheets("Combine Build List").Unprotect ("Combine")
myST(2).Range(Cells(1, LastCol2 + 1).Address, Cells(1, myLastM + 1).Address).EntireColumn.Delete
'Sheets("Combine Build List").Protect ("Combine")
For i1 = 1 To 3
Set myST(i1) = Nothing
Next i1
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
Sheets("Data Storage").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Weight Summary").Select
ActiveSheet.Unprotect ("Combine")
ActiveSheet.PivotTables("Weight_Summary").PivotCache.Refresh
ActiveSheet.Protect ("Combine")
Application.ScreenUpdating = True
End Sub