How to stop code at the last row while running VB code for merging sheets

EDN Admin

Well-known member
Joined
Aug 7, 2010
Messages
12,794
Location
In the Machine
I am trying to merg sheets in MSXcel, using below code, I dont know the flaw of code that it is not stopping exactly at the last populated row, rather it is going to down 6-7 row below the target row. Also, just to make it clear I have formulas set
in cells below which are empty.
CODE:-
"
<p style="margin:6px 24px; font:15px Courier <span style="color:blue Sub CopyFromWorksheets()
<br/>
<span style="color:blue Dim wrk <span style="color:blue
As Workbook <span style="color:darkgreen Workbook object - Always good to work with object variables<br/>
<span style="color:blue Dim sht <span style="color:blue
As Worksheet <span style="color:darkgreen Object for handling worksheets in loop<br/>
<span style="color:blue Dim trg <span style="color:blue
As Worksheet <span style="color:darkgreen Master Worksheet<br/>
<span style="color:blue Dim rng <span style="color:blue
As Range <span style="color:darkgreen Range object<br/>
<span style="color:blue Dim colCount <span style="color:blue
As <span style="color:blue Integer <span style="color:darkgreen Column count in tables in the worksheets<br/>
<br/>
<span style="color:blue Set wrk = ActiveWorkbook <span style="color:darkgreen
Working in active workbook<br/>
<br/>
<span style="color:blue For Each sht <span style="color:blue
In wrk.Worksheets <br/>
<span style="color:blue If sht.Name = "Master"
<span style="color:blue Then <br/>
MsgBox "There is a worksheet called as Master." & vbCrLf & _
<br/>
"Please remove or rename this worksheet since Master would be" & _
<br/>
"the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
<br/>
Exit <span style="color:blue
Sub <br/>
<span style="color:blue End <span style="color:blue
If <br/>
<span style="color:blue Next sht <br/>
<br/>
<span style="color:darkgreen We dont want screen updating<br/>
Application.ScreenUpdating = <span style="color:blue False
<br/>
<br/>
<span style="color:darkgreen Add new worksheet as the last worksheet<br/>
<span style="color:blue Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
<br/>
<span style="color:darkgreen Rename the new worksheet<br/>
trg.Name = "Master" <br/>
<span style="color:darkgreen Get column headers from the first worksheet<br/>
<span style="color:darkgreen Column count first<br/>
<span style="color:blue Set sht = wrk.Worksheets(1) <br/>
colCount = sht.Cells(1, 255).End(xlToLeft).Column <br/>
<span style="color:darkgreen Now retrieve headers, no copy&paste needed<br/>
<span style="color:blue With trg.Cells(1, 1).Resize(1, colCount)
<br/>
.Value = sht.Cells(1, 1).Resize(1, colCount).Value
<br/>
<span style="color:darkgreen Set font as bold<br/>
.Font.Bold = <span style="color:blue
True <br/>
<span style="color:blue End With <br/>
<br/>
<span style="color:darkgreen We can start loop<br/>
<span style="color:blue For Each sht <span style="color:blue
In wrk.Worksheets <br/>
<span style="color:darkgreen If worksheet in loop is the last one, stop execution (it is Master worksheet)<br/>
<span style="color:blue If sht.Index = wrk.Worksheets.Count
<span style="color:blue Then <br/>
Exit <span style="color:blue
For <br/>
<span style="color:blue End <span style="color:blue
If <br/>
<span style="color:darkgreen Data range in worksheet - starts from second row as first rows are the header rows in all worksheets<br/>
<span style="color:blue Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
<br/>
<span style="color:darkgreen Put data into the Master worksheet<br/>
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
<br/>
<span style="color:blue Next sht <br/>
<span style="color:darkgreen Fit the columns in Master worksheet<br/>
trg.Columns.AutoFit <br/>
<br/>
<span style="color:darkgreen Screen updating should be activated<br/>
Application.ScreenUpdating = <span style="color:blue True
<br/>
<span style="color:blue End Sub "

View the full article
 
Back
Top