Change existing macro to copy formulas from specific columns - vba

Question

This is my still my first macro, I have been searching like a mad man trying to get this to work...and it's getting close!
I have it set to copy "Pricing_Cost" sheet from Active workbook into a new workbook as values and then manipulate it beyond that. What I really need is to modify that step so that certain columns copy values, others copy formulas. I have columns A:X
Columns needing to be pasted as values = A,E,F,H,I,J,K,L,M,N,T,U,V,W,X
Columns needing to pasted as formula = B,C,D,G,O,P,Q,R,S
This is within the CopyRemoveFormSave sub
I'm guessing maybe I should copy the whole thing as formulas and then cut and paste as values the columns that need to be converted to values? Not really sure how to do that with the code I have here...
Public strFile As String
Sub RunAll()
Call load_csv
Call CopyRemoveFormAndSave
Call Splitbook
End Sub
Sub load_csv()
Dim fStr As String
With Application.FileDialog(msoFileDialogFilePicker)
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Cancel Selected"
Exit Sub
End If
'fStr is the file path and name of the file you selected.
fStr = .SelectedItems(1)
End With
Sheets("Product_Weekly").UsedRange.ClearContents
With ThisWorkbook.Sheets("Product_Weekly").QueryTables.Add(Connection:= _
"TEXT;" & fStr, Destination:=ThisWorkbook.Sheets("Product_Weekly").Range("$A$1"))
.Name = "CAPTURE"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Declare PtrSafe Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH As Long = 260
'~~> Function to get user's temp directoy
Function TempPath() As String
TempPath = String$(MAX_PATH, Chr$(0))
GetTempPath MAX_PATH, TempPath
TempPath = Replace(TempPath, Chr$(0), "")
End Function
Sub CopyRemoveFormAndSave()
Dim wb As Workbook, wbNew As Workbook
Dim ws As Worksheet
Dim wsName As String, NewName As String
' Dim shp As Shape
Set wb = ThisWorkbook
wsName = ActiveSheet.Name
NewName = wsName & ".xlsm"
wb.SaveCopyAs TempPath & NewName
Set wbNew = Workbooks.Open(TempPath & NewName)
wbNew.Sheets(wsName).UsedRange.Value = wbNew.Sheets(wsName).UsedRange.Value
Application.DisplayAlerts = False
For Each ws In wbNew.Worksheets
If ws.Name <> wsName Then ws.Delete
Next ws
Application.DisplayAlerts = True
' For Each shp In wbNew.Sheets(wsName).Shapes
' If shp.Type = 8 Then shp.Delete
' Next
'
'~~> Do a save as for the new workbook if required.
'
'End Sub
Columns("W:W").Replace "2", "KevinClark", xlWhole
Columns("W:W").Replace "9", "PaulG", xlWhole
Columns("W:W").Replace "O", "KevinClark", xlWhole
Columns("W:W").Replace "I", "KevinClark", xlWhole
Columns("W:W").Replace "4", "PaulG", xlWhole
Columns("W:W").Replace "8", "KevinClark", xlWhole
Columns("W:W").Replace "7", "KevinClark", xlWhole
'Sub SplitData()
Const NameCol = "W"
Const HeaderRow = 3
Const FirstRow = 4
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim SrcRow As Long
Dim LastRow As Long
Dim TrgRow As Long
Dim Buyer As String
Application.ScreenUpdating = False
Set SrcSheet = ActiveSheet
LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
For SrcRow = FirstRow To LastRow
Buyer = SrcSheet.Cells(SrcRow, NameCol).Value
Set TrgSheet = Nothing
On Error Resume Next
Set TrgSheet = Worksheets(Buyer)
On Error GoTo 0
If TrgSheet Is Nothing Then
Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
TrgSheet.Name = Buyer
' SrcSheet.Range(HeaderRow).Copy Destination:=TrgSheet.Range(HeaderRow)
SrcSheet.Range("A1:W3").Copy Destination:=TrgSheet.Range("A1:W3")
End If
TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
Next SrcRow
Application.ScreenUpdating = True
Dim sht As Worksheet
''AutoFit One Column
' ThisWorkbook.Worksheets("Sheet1").Columns("O:O").EntireColumn.AutoFit
'
''AutoFit Multiple Columns
' ThisWorkbook.Worksheets("Sheet1").Range("I:I,L:L").EntireColumn.AutoFit 'Columns I & L
' ThisWorkbook.Worksheets("Sheet1").Range("I:L").EntireColumn.AutoFit 'Columns I to L
'
''AutoFit All Columns on Worksheet
' ThisWorkbook.Worksheets("Sheet1").Cells.EntireColumn.AutoFit
'AutoFit Every Worksheet Column in a Workbook
For Each sht In wbNew.Worksheets
sht.Cells.EntireColumn.AutoFit
Next sht
End Sub
Sub Splitbook()
'Updateby20140612
Dim xPath As String
xPath = "C:\Users\Jimbo.JAMESP-ACERLT\Documents\For Gary\Output"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ActiveWorkbook.Sheets
If xWs.Name <> "Pricing Cost" Then
xWs.Copy
Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
Application.ActiveWorkbook.Close False
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Answer 1

As you say I think the best step is to copy all as formulas initially. What I would do next is define an array which contains the column letters which you need to be values, you can do that as follows.
ValArr = Array("A","E","F","H","I","J","K","L","M","N","T","U","V","W","X")
Then you can loop through this array and turn each column to values.
For x = Lbound(ValArr) To Ubound(ValArr)
'Paste values in column ValArr(x)
Next
I hope this helps, let me know if you need any more clarification.

Answer 2

You can do it without any copy and pasting. For example let's say you want to copy all the formulas from Sheet1 to Sheet2 you can do something like this:
for i = 1 to lastRow
for j in 1 to lastCol
Sheets("Sheet2").cells(i,j).formula = Sheets("Sheet1").cells(i,j).formula
next j
next i
Also if there's no formula it just copies the text so you can do that for all the cells.