Hello all,

It is my first time on this forum. I need help creating a macro and I realized after some research I can´t do it on my own.

So maybe somebody can help me with this macro.

What I need :

I have a workbook were I put usually different data but in the exact same cells.
I will call it HomeWB.

So, I want to copy this data's to another workbook (let's call it SecondWB), and this data should be organize by sheets. The sheets will be named as the cell C12 from HomeWB.

So I need a macro that search from the HomeWB - C12 cell and identifies the sheet on the SecondWB. Make it active and then select the last empty row and copy some different cell from the HomeWB.

Exempale Copy the cells C9, G9, G32 from HomeWB in to SecondWB B1, B2, B3.
Since I was thinking to put this formula in A1 that excel finds the worksheet name :

=MID(CELL("filename";$A$1);FIND("]";CELL("filename";$A$1);1)+1;LEN(CELL("filename";$A$1))-FIND("]";CELL("filename";$A$1);1))

So actually after finding this A1 value from HomeWB C12 value, it has to make the A1 cell active, and then identify the last cell free from A column make it active and copy the values.

If C12 will not be find in the SecondWB than create a new sheet with C12 name, copy the formula (=MID(CELL("filename";$A$1);FIND("]";CELL("filename";$A$1);1)+1;LEN(CELL("filename";$A$1))-FIND("]";CELL("filename";$A$1);1))) in A1, and then the values.

Can somebody help me with this macro ?
I have nothing until now. Actually I have some code parts that I can't combine.

If it is possible I would like also that the macro contain a line to open SecondWB if it isn't opened, and after copying the values to save it and close it.

Thank you in advance

Here is what I got until now :

Sub Button1_Click()

Dim strWSName As String
Dim YesOrNoAnswerToMessageBox As String
Dim QuestionToMessageBox As String
Dim nextRow As Integer

'name of the subcontractor with letter case
strWSName = UCase(Range("c12"))


'search for sheet name and activate it
If SheetExists(strWSName) Then
Worksheets(strWSName).Activate
'HERE I HAVE TO PUT THE VBA CODE FOR COPYING THE VALUE FROM THE COVER INVOICE
nextRow = Sheets(strWSName).Range("A" & Rows.Count).End(xlUp).Row + 1
'I'm blocked here

'create the sheet if it doesn't exist
Else
QuestionToMessageBox = "The Sheets Name Doesn't exists. Do you want to create it?"
YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbYesNo, "VBA Expert or Not")

If YesOrNoAnswerToMessageBox = vbYes Then
Sheets.Add.Name = strWSName
Else
MsgBox "You pressed NO!"
End If
End If

End Sub



'search function for the sheet's name
Function SheetExists(strWSName As String) As Boolean
Dim ws As Worksheet
Dim wb As Workbook
Dim strFileName As String
strFileName = "C:\Documents and Settings\HorbaniucVla\Desktop\New Folder\suppliers overview.xls"

'Check if the workbook is already opened and if yes activate him
If Not FileLocked(strFileName) Then
Set wb = Application.Workbooks.Open("C:\Documents and Settings\HorbaniucVla\Desktop\New Folder\suppliers overview.xls")
Else
Workbooks("suppliers overview.xls").Activate
End If

On Error Resume Next
Set ws = Worksheets(strWSName)
If Not ws Is Nothing Then SheetExists = True
End Function



'check if the file is already opened
Function FileLocked(strFileName As String) As Boolean
On Error Resume Next
' If the file is already opened by another process,
' and the specified type of access is not allowed,
' the Open operation fails and an error occurs.
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
' If an error occurs, the document is currently open.
If Err.Number <> 0 Then
' Display the error number and description.
MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description
FileLocked = True
Err.Clear
End If
End Function