Want to copy rows based on input of a cell - excel

Question

I have this code that I've been using (not mine). It works well with me because I know that I can change the value in sh.Rows ("x") to whatever row I want and it'll grab everything that I need. I want to make this easier for one of my co workers to use so that they wouldn't have to go into Visual Basics to edit it. Is there an easy way to make it so that it can take whatever row that's in cell B2 from every sheet and paste it into a master sheet?
Sub CopytoMaster()
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 Then
If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
sh.Rows("7").Copy DestSh.Cells(Last + 1, 1)
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Sub CheckMaster()
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 Then
If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
With sh.Rows("7")
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

Answer 1

You can simply use the Range.Value method to grab the value of B2. Place this within the .Row() method. In other words, you would just need to change your sh.Rows("7") to sh.Rows(ws.range("B2").value).
Sub CopytoMaster()
Dim sh As Worksheet, ws 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 Then
If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
sh.Rows(ws.Range("B2").Value).Copy DestSh.Cells(Last + 1, 1)
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Same thing with your second procedure:
Sub CheckMaster()
Dim ws As Worksheet
...
With sh.Rows(ws.Range("B2").Value)
DestSh.Cells(Last + 1, 1).Resize(.Rows.Count, _
.Columns.Count).Value = .Value
End With
Where ws is the worksheet object that contains the value in question. You weren't clear on if this was the same worksheet as sh or not, so if it is you can change ws to sh - otherwise, you will need to Set ws to the sheet that contains the value.

Answer 2

This is what I have now and it is working pretty much how I want it to.
Sub CopytoMaster2()
Dim wb As Workbook
Dim sh As Worksheet
Dim ws As Worksheet
Dim DestSh As Worksheet
Dim mainSh 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"
Set wb = ActiveWorkbook
Set mainSh = wb.Sheets("Main")
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> mainSh.Name And sh.Name <> DestSh.Name Then
If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
sh.Rows(mainSh.Range("E7").Value).Copy DestSh.Cells(Last + 1, 1)
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Sub CheckMaster2()
Dim wb As Workbook
Dim sh As Worksheet
Dim ws As Worksheet
Dim DestSh As Worksheet
Dim mainSh 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"
Set wb = ActiveWorkbook
Set mainSh = wb.Sheets("Main")
For Each sh In ThisWorkbook.Worksheets
If mainSh.Name <> sh.Name And sh.Name <> DestSh.Name Then
If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
With sh.Rows(mainSh.Range("E7").Value)
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 LastRow2(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 Lastcol2(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 SheetExists2(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