Option Explicit
Sub dunno()
Const FindSheet As String = "F_H"
Const DestinationFile As String = "Kavin"
Const DestinationSheet As String = "Master sheet"
Const SheetPassword As String = "password for sheet goes here"
Const FilesFilter As String = "Description (*.xls), *.xls"
Dim SourceWB As Workbook
Dim SourceWS As Worksheet
Dim DestinationWB As Workbook
Dim DestinationWS As Worksheet
Dim SourceWasOpen As Boolean
Dim SheetIsThere As Boolean
Dim SheetProtected As Boolean
Dim LastRow As Long
Dim FindFile As String
Dim SourceName As String
Dim SourcePath As String
If ISWBOPEN(DestinationFile) = True Then
Set DestinationWB = Workbooks(DestinationFile)
If WSEXISTS(DestinationSheet, DestinationWB) = True Then
FindFile = Application.GetOpenFilename(FilesFilter)
If FindFile = "False" Then
'user pressed cancel
Exit Sub
End If
Call TOGGLEEVENTS(False)
SourcePath = Left(FindFile, InStrRev(FindFile, "\"))
SourceName = Right(FindFile, Len(FindFile) - Len(SourcePath))
SourceWasOpen = ISWBOPEN(SourceName)
If SourceWasOpen = True Then
Set SourceWB = Workbooks(SourceName)
Else
Set SourceWB = Workbooks.Open(FindFile)
End If
SheetIsThere = WSEXISTS(FindSheet, SourceWB)
If SheetIsThere = True Then
'sheet exists
Set SourceWS = SourceWB.Worksheets(FindSheet)
SheetProtected = SourceWS.ProtectContents
If SheetProtected Then Call UNPROTECTSHEET(SourceWS, SheetPassword)
If SourceWS.ProtectContents = False Then
'unprotected, do stuff
LastRow = SourceWS.Cells(SourceWS.Rows.Count, "B").End(xlUp).Row
'check for value in B4
If Len(SourceWS.Range("B4").Value) > 0 Then
SourceWS.Range("B4:W4").Copy DestinationWS.Range("B4:W4")
End If
'check for value in B5 to last data in column B
If WorksheetFunction.CountA(SourceWS.Range("B5:B" & LastRow)) > 0 And LastRow >= 5 Then
SourceWS.Range("B5:W" & LastRow).Copy DestinationWS.Range("B5:W" & LastRow)
End If
'check for value in Z3
If Len(SourceWS.Range("Z3").Value) > 0 Then
SourceWS.Range("Z3").Copy DestinationWS.Range("Z4")
End If
Else
'protected still, password didnt' work, do nothing
End If
Else
'sheet does not exist, do nothing
End If
If SourceWasOpen = True Then
If SheetIsThere = True Then
SourceWB.Close SaveChanges:=True
Else
SourceWB.Close SaveChanges:=False
End If
End If
Call TOGGLEEVENTS(True)
Else
MsgBox "Worksheet not found in destination file."
End If
Else
MsgBox "Destination workbook not open."
End If
End Sub
Sub UNPROTECTSHEET(ByVal WKS As Worksheet, ByVal TryPassword As String)
If WKS.ProtectContents = False Then Exit Sub
On Error Resume Next
WKS.Unprotect TryPassword
On Error GoTo 0
End Sub
Sub TOGGLEEVENTS(ByVal blnState As Boolean)
'Originally written by Zack Barresse
Application.DisplayAlerts = blnState
Application.EnableEvents = blnState
Application.ScreenUpdating = blnState
If blnState Then Application.CutCopyMode = False
If blnState Then Application.StatusBar = False
End Sub
Function ISWBOPEN(ByVal wkbName As String) As Boolean
On Error Resume Next
ISWBOPEN = CBool(Len(Workbooks(wkbName).Name) <> 0)
On Error GoTo 0
End Function
Function WSEXISTS(ByVal wksName As String, Optional ByVal WKB As Workbook) As Boolean
If WKB Is Nothing Then
If ActiveWorkbook Is Nothing Then Exit Function
Set WKB = ActiveWorkbook
End If
On Error Resume Next
WSEXISTS = CBool(Len(WKB.Worksheets(wksName).Name) <> 0)
On Error GoTo 0
End Function