excel vba - paste into specific workboo & sheet, if not there then create

[JSemper]

I have a macro that takes a range of cells from my current workbook, opens a specific workbook, pastes the cells into that workbook, saves and closes. This works just fine.

As this macro is applied to multiple workbooks i need it to paste into a worksheet dependent on information from the 1st workbook.

i.e
Open destination workbook2
look for worksheet called the value of workbook1/sheet1/cellA1
if it is not there then create a new worksheet called the value of workbook1/sheet1/cellA1
it is there then contiue with my paste&save macro

Here is my macro so far:

Sub copy_paste()

Dim firstbook As Workbook
Set firstbook = ThisWorkbook

firstbook.Sheets("sheet1").Select
Range("b5:e40").Cells.Copy

Workbooks.Open Filename:="P:string\workbook2.xls"
Sheets("sheet3").Range("b3").Cells.PasteSpecial xlPasteValuesAndNumberFormats

Workbooks("workbook2.xls").Save
Workbooks("workbook2.xls").Close

End Sub

 

[Chris Mack]

Perhaps adding something like this:

    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name = "Sheet3" Then GoTo exists
    Next
    Sheets.Add.Name = "Sheet3"
exists:

Hope this helps,

Chris.

 

[JSemper]

    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name = "Sheet3" Then GoTo exists
    Next
    Sheets.Add.Name = "Sheet3"
exists:

QUOTE]

Thanks, this is close but I need 'sheet3' to be determined by what is written in cell A1 in workbook1/sheet1. For example if cellA1 was to contain the word 'TOMORROW' then the above code would need to look for a worksheet called 'tomorrow'. Are you able to pop that query into there?

 

[Chris Mack]

    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name = firstbook.Sheets("Sheet1").Range("A1") Then GoTo exists
    Next
    Sheets.Add.Name = firstbook.Sheets("Sheet1").Range("A1")
exists:

That should work.

Chris

 

[dmt32]

Not tested but see if this does what you want.

Sub copy_paste()


    Dim firstbook As Workbook, wbDest As Workbook
    Dim wsDest As Worksheet
    Dim SourceRange As Range
    Dim DestSheet As String


    Set firstbook = ThisWorkbook


    With firstbook.Sheets("sheet1")
        Set SourceRange = .Range("b5:e40")
        DestSheet = .Range("A1").Value
    End With


    If Len(DestSheet) > 0 Then
        On Error GoTo myerror
        Set wbDest = Workbooks.Open(Filename:="P:string\workbook2.xls", ReadOnly:=False)


        With wbDest
            Set wsDest = .Worksheets(DestSheet)


            SourceRange.Copy
            wsDest.Range("b3").Cells.PasteSpecial xlPasteValuesAndNumberFormats


            'close & save
            .Close True
        End With
    End If


myerror:
    Application.CutCopyMode = False
    If Err > 0 Then
        If Err.Number = 9 Then
            Set wsDest = wbDest.Worksheets.Add(after:=wbDest.Worksheets(wbDest.Worksheets.Count))
            wsDest.Name = DestSheet
            Err.Clear
            Resume Next
        Else
            MsgBox (Error(Err)), 48, "Error"
        End If
    End If
    Set firstbook = Nothing
    Set wbDest = Nothing
End Sub

Dave

 

[JSemper]

Hi Dave

Your one worked great, taken it and added a few formatting bits to get the sheet how I'd like it. So thankyou!

James

 

[dmt32]

Hi Dave

Your one worked great, taken it and added a few formatting bits to get the sheet how I'd like it. So thankyou!

James

very welcome thanks for feedback.

Dave