View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
dave dave is offline
external usenet poster
 
Posts: 37
Default update...

Making a little progress. I found the following script
online and have tried this. This is very close. I just
need it to do the following:

When it makes a sheet called Master and copies, start
copying the data at row 3 (row 1 & 2 are headers).

I have it hard coded to copy from A3 to R30. I will always
start at A3, but the data may go past row R, it may not. I
would like this to check and keep copying rows until Row A
contains a blank value in column 1.... essentially I do
not want ot hard code the rows to copy.


Sub CopyRange()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
'If SheetExists("Master") = True Then
' MsgBox "The sheet Master already exist"
' Exit Sub
'End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Delete
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name And sh.Name
< "Definitions" Then
If sh.UsedRange.Count 1 Then
Last = LastRow(DestSh)
sh.Range("A3:R30").Copy DestSh.Cells(Last
+ 1, 1)
End If
End If
Next
Application.ScreenUpdating = True
End Sub

Sub CopyRangeValues()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
' If SheetExists("Master") = True Then
' MsgBox "The sheet Master already exist"
' Exit Sub
'End If
Application.ScreenUpdating = False

Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name And sh.Name
< "Definitions" Then
If sh.UsedRange.Count 1 Then
Last = LastRow(DestSh)
With sh.Range("A3:R30")
DestSh.Cells(Last + 1, 1).Resize
(.Rows.Count, _
.Columns.Count).Value = .Value
End With
End If
End If
Next
Application.ScreenUpdating = True
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function

Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As
Boolean
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(Sheets(SName).Name))
End Function