I want to consolidate data from multiple worksheets however it only copies the value without copying the format. i need it to copy the format as well because there is one field need to have number in the format 0013. but when i run this code, the number will display 13 instead. please check my code below;
Option Compare Text
Sub CompileWholeData()
Dim wksWorksheet As Worksheet
Dim wbkNew As Workbook
Dim wbkNewData As Workbook
Dim Arr()
Dim lngWksCnt As Long
Dim lngMArrCnt As Long
Dim lngLArrR As Long
Dim lngLArrC As Long
Dim lngLastR As Long
Dim Arr1 As Range
Dim rngCell As Range
Dim rngWhole As Range
Set wbkNew = Workbooks.Open("C:\Documents and Settings\user\My Documents\FiST Mac\FISTdb.xls")
ReDim Arr(wbkNew.Worksheets.Count)
lngWksCnt = 0
For Each wksWorksheet In wbkNew.Worksheets
Arr(lngWksCnt) = wksWorksheet.Range("A4").CurrentRegion
lngWksCnt = lngWksCnt + 1
Next
Set wbkNewData = Workbooks.Add(1)
With wbkNewData.Worksheets("Sheet1")
For lngMArrCnt = 0 To UBound(Arr) - 1
lngLArrR = UBound(Arr(lngMArrCnt), 1)
lngLArrC = UBound(Arr(lngMArrCnt), 2)
lngLastR = .Range("B" & Rows.Count).End(xlUp).Row
.Range("A" & lngLastR + 1).Resize(lngLArrR, lngLArrC) = Arr(lngMArrCnt)
Next
.Columns("A:A").Delete
.Rows("1:1").Delete
Set rngWhole = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp))
For Each rngCell In rngWhole
If rngCell.Value = "Stock Code" Then
If rngCell.Row <> 1 Then
rngCell.EntireRow.Delete
End If
End If
Next
End With
End Subwhat should i add so that it will copy the format as well?
