I have a task that I desperately need to complete, but I am having problem with three points and I am hoping you can help.
I have this code that works well to Copy specific ranges from vertical to horizontal From all closed workbooks to the workbook totals amounts
Here is a brief rundown of what I am attempting to do in two worksheet Total cash sales & Total Deferred Sales in the workbook totals amounts.
Code: Select all
Option Explicit
Sub test()
Dim tt$, rb(1 To 2), a, b, c, ws As Worksheet, mFile$
Dim mRow(1 To 2) As Long, i%, d%, e%, mCol As Integer
Application.ScreenUpdating = False: DoEvents
tt = ThisWorkbook.Path & "\"
rb(1) = "cash sales": rb(2) = "Deferred Sales"
a = CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files.Count
ReDim c(1 To a, 1 To 77)
ReDim b(1 To 2)
b(1) = c
b(2) = c
Set ws = Workbooks.Add.Sheets(1)
mFile = Dir(tt & "*.xlsx")
Do Until mFile = ""
DoEvents
For i = 1 To 2
ws.Range("A1:D45") = "='" & tt & "[" & mFile & "]" & rb(i) & "'!A1"
a = ws.Range("A1:D45").Value
mRow(i) = 1 + mRow(i)
b(i)(mRow(i), 1) = a(1, 1)
mCol = 1
For d = 1 To 3 Step 2
For e = 3 To 45
If a(e, d) <> 0 Then
mCol = 1 + mCol
If a(e, d + 1) <> "" And a(e, d + 1) <> 0 Then b(i)(mRow(i), mCol) = a(e, d + 1)
End If
Next
Next
Next
mFile = Dir
Loop
ws.Parent.Close False
For i = 1 To 2
With Sheets(i).Range("A1").CurrentRegion
.Offset(1).Delete xlShiftUp
.Offset(1).Resize(mRow(i)) = b(i)
.Offset(1 + mRow(i)) = "=Sum(R2C:R[-1]C)"
.Offset(1 + mRow(i))(1) = "FINAL TOTAL"
End With
Next
End
End Sub
2) I need to change the row height for that contains "Final Total" to 60 points.
3) Last point if possible I need to include the borders in two worksheet Total cash sales & Total Deferred Sales
How can These points is included with this code referred to above ... Thank you for your assistance in this