Hye What I am trying to do is:
My problem is:
I want to replace this twb.Sheets(Array("Summary", "M 100P 1", "M 100P 2", "M 100P 5", "M 100P 6", "M 100P 12", "M 100P 13", "M 100P 15", "M 100P 16")).Copy
with a dynamic array because the name of the merge sheet follow their original file and it might be vary That I cannot use "Like" condition so I try to use the code below but it return myArray is empty
Option Base 1
Sub SheetsArr()
Dim myArray() As String
Dim myCount As Integer, NumSheets As Integer
NumSheets = ThisWorkbook.Worksheets.Count - 4
ReDim myArray(1 To NumSheets)
For myCount = 4 To NumSheets
myArray(myCount) = ActiveWorkbook.Sheets(myCount).Name
Next myCount
End Sub
Got error
Type Mismatch error
and highlight this line of code on the main module
If UBound(myArray) > 0 Then Worksheets(myArray).Copy
Here is my main module code:
Private Sub OpenWorkBook_Click()
'for merge sheet from other workbooks
Dim wbk, twb As Workbook
Dim sPath, sFile, sName, mySheet As String
Dim cpt, wsCountMerge, wsCount, WsIndex As Integer
sPath = "C:\Users\mazman\Desktop\Hilmi\data Summary\" 'Your folder path
sFile = Dir(sPath & "*.xls*")
Set twb = ThisWorkbook
Application.ScreenUpdating = 0
Countmergesheet = 0
Do While sFile <> "" 'merge raw data sheet process start here
Set wbk = Workbooks.Open(sPath & sFile)
With wbk
sName = Split(Split(.Name, "_")(6), ".")(0) 'initialize sheet name based on the file name
.Sheets(3).Copy after:=twb.Sheets(twb.Sheets.Count) 'copy each sheets(3) from the data summary and paste after visible sheet on this workbook
.Close 0
End With
With twb
.ActiveSheet.Name = sName 'rename sheet
.ActiveSheet.Range("A1:R1").RowHeight = 45
.ActiveSheet.Range("A1:R1").WrapText = True
.ActiveSheet.Range("A1:R1").Interior.ColorIndex = 15
End With
sFile = Dir()
If twb.ActiveSheet.Name = sName Then
Countmergesheet = Countmergesheet + 1 'count how many sheet is merge
End If
Loop
wsCount = twb.Sheets.Count
wsCountMerge = wsCount - Countmergesheet 'to get the 1st merge sheet index
WsIndex = wsCount - 1 'to get the last sheet index
'################# This section copy data from origin sheet #################
'###### to formula sheet then paste result to its origin sheet ##############
For i = wsCountMerge To WsIndex
With twb
.Sheets(i).Range("A2:R3063").Copy
.Worksheets("STEP 1").Range("A3").PasteSpecial xlPasteValues
.Sheets(i).Cells.Clear
.Sheets(3).Range("A9:O27").Copy
.Sheets(i).Range("A1").PasteSpecial xlPasteAllUsingSourceTheme
.Sheets(i).Range("A1").PasteSpecial xlPasteValues
.Sheets(i).Range("A1:O19").ColumnWidth = 10.8
'################# This section copy data to summary sheet ################
.Sheets(i).Range("A2:O18").Copy
.Worksheets("Summary").Select
ActiveSheet.Range("B" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
For j = 1 To 17
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.Value = .Sheets(i).Name
ActiveCell.BorderAround , xlThin
Next j
.Worksheets("STEP 1").Range("A3:R6034").Clear
.Worksheets("STEP 1").Activate: .Sheets("STEP 1").Cells(1).Select
.Sheets(i).Activate: .Sheets(i).Cells(1).Select
.Sheets("Summary").Activate: .Sheets("Summary").Cells(1).Select
'###### End of section ################
End With
Next i
Call InsertFormulas
Call SheetsArr
If UBound(myArray) > 0 Then Sheets(myArray).Copy
ActiveWorkbook.SaveAs Filename:=sPath & "Summary Report" & ".xlsx"
End Sub
Your ReDim
makes myArray
start from 1.
But the for-loop counter, myCount
, starts from 4.
I correct the for-loop counter, myCount
, start from 1 as below.
Sub SheetsArr()
Dim myArray() As Variant
Dim myCount As Long, NumSheets As Long
NumSheets = ThisWorkbook.Worksheets.Count - 4
ReDim myArray(1 To NumSheets)
For myCount = 1 To NumSheets
myArray(myCount) = ActiveWorkbook.Sheets(myCount).Name
Next myCount
End Sub
According your main module
code, I think you could
rewrite your SheetArr()
sub to a function as below.
Option Base 1
Function SheetsArr() As Variant
Dim myArray() As Variant 'from String to Variant
Dim myCount As Long, NumSheets As Long 'from Integer to Long
NumSheets = ThisWorkbook.Worksheets.Count - 4
ReDim myArray(1 To NumSheets)
For myCount = 1 To NumSheets
myArray(myCount) = ThisWorkbook.Worksheets(myCount).Name 'from ActiveWorkbook.Sheets to ThisWorkbook.Worksheets as the definition of NumSheets
Next myCount
SheetsArr = myArray
End Function
In main module
, you need to add
Dim myArray As Variant
rewrite
Call SheetsArr
to
myArray = SheetsArr()