tweetytoon
New Member
- Joined
- Jan 21, 2021
- Messages
- 2
- Office Version
- 365
below code is pasting formulas and i want to past values
VBA Code:
Sub Consolidate_Data()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Consolidated_Data")
Dim logs As Worksheet
Set logs = ThisWorkbook.Sheets("logs")
Dim i As Integer
Dim arr
Dim n, x As Long
Dim wb As Workbook
Dim dsh As Worksheet
Dim str As String
arr = Application.GetOpenFilename(MultiSelect:=True)
For i = LBound(arr) To UBound(arr)
n = sh.Range("A" & Application.Rows.Count).End(xlUp).Row + 1 '''last row of consolidated_data sheet
x = logs.Range("A" & Application.Rows.Count).End(xlUp).Row + 1 '''last row of logs sheet
Set wb = Workbooks.Open(arr(i))
Set dsh = wb.Sheets(1)
dsh.UsedRange.Copy sh.Range("A" & n)
'''''''update logs
logs.Range("A" & x).Value = wb.Name
logs.Range("B" & x).Value = Application.WorksheetFunction.CountA(dsh.Range("A:A")) - 1
wb.Close False ''''''''' close worksheets
Next i
'''''data formatting in consolidated_Data sheet tab
sh.Range("1:1").Delete
sh.UsedRange.AutoFilter 1, "Date"
sh.Range("A2:A" & Application.Rows.Count).SpecialCells(xlCellTypeVisible).EntireRow.Delete
sh.AutoFilterMode = False
''''''''' Data formatting
With sh.UsedRange
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlJustify
.EntireColumn.ColumnWidth = 15
.EntireRow.RowHeight = 15
.Font.Size = 10
.Font.Name = "Calibri"
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlHairline
End With
With sh.Range("A1:I1")
.Font.Bold = True
.Interior.Color = vbBlack
End With
End Sub
Last edited by a moderator: