• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA Macro to open xlsm while in another workbook

S

slohman

Member
I'm new to this so here goes

I have a macro that finds text in a Workbook (named Tester) with a Worksheet (named Estimate1) and copies to another worksheet (named Works) which I would rather save to another workbook (Cost Schedule.xlsm) but can only get it to send to a worksheet as when I try to open Cost Schedule it has an error 1004 cannot open file extension.

I then need it to copy
Code: 
Sub EstimatetoWorkSchedule()
Dim SheetName As String
SheetName = "Estimate1"
SheetName = InputBox("enter the name of a sheet to use", "sheet name", SheetName)
Dim i As Long
Dim MyCol As Integer
Dim MyRow As Integer

    Range("B4:M656").Select
    Selection.ClearContents

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 4
    For i = 1 To 1
        If Sheets(SheetName).Range("B" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("B" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 12
    For i = 12 To 12
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 14
    For i = 14 To 14
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 20
    For i = 20 To 20
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 27
    For i = 27 To 30
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i


LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 32
    For i = 32 To 32
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 36
    For i = 36 To 37
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 43
    For i = 43 To 44
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 3
MyRow = 43
    For i = 43 To 44
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("C" & i).Value
                    MyCol = 3
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 46
    For i = 46 To 46
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i


LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 3
MyRow = 46
    For i = 46 To 46
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("C" & i).Value
                    MyCol = 3
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 48
    For i = 48 To 48
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i


LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 3
MyRow = 48
    For i = 48 To 48
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("C" & i).Value
                    MyCol = 3
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 57
    For i = 57 To 57
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 59
    For i = 59 To 61
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 3
MyRow = 59
    For i = 59 To 61
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("C" & i).Value
                    MyCol = 3
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 68
    For i = 68 To 71
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 3
MyRow = 68
    For i = 68 To 71
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("C" & i).Value
                    MyCol = 3
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 79
    For i = 79 To 82
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 87
    For i = 87 To 87
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 91
    For i = 91 To 91
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 103
    For i = 103 To 105
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 109
    For i = 109 To 172
        If Sheets(SheetName).Range("A" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i

LR = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 765
    For i = 765 To 765
        If Sheets(SheetName).Range("l" & i).Value <> "" Then
            Sheets("Work Schedule").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("m" & i).Text
                    MyCol = 2
                    MyRow = MyRow + 1
            End If
    Next i
'
    Range("B4:C657").Select
    Selection.AutoFilter
    ActiveSheet.Range("$B$3:$C$657").AutoFilter Field:=1, Criteria1:="<>"

    Columns("H:I").Select
    Selection.EntireColumn.Hidden = True
   
   
End Sub
 
I need the copied cells that appear in Worksheet (Works) to copy to Cost Schedule Workbook. So open Cost Schedule Workbook when macro runs and copy cells to next blank row
 
Hi ,

Your first post mentioned that you had an error message when you try to open the Cost Schedule.xlsm file ; my point is where is the statement to do this in the code you have posted ?

Within the code , you are transferring a lot of data from the Estimate1 sheet to the Works Schedule sheet ; then you are doing an autofilter , and then hiding some columns ; where does the transfer of data to the external workbook come in ? Please be a little more detailed in what you wish to do.

Narayan
 
Ok I will try again to explain.

The code I was trying to use to transfer data is this one which I had put in Worksheet Estimate1 this is a seperate macro to run after all the text had been copied and filtered.

I prefer if this could be added to the original CODE as the last thing that it does.

Code: 
Sub OpenAndSaveNewBook()
    Dim MyBook As Workbook, newBook As Workbook
    Dim FileNm As String

    Set MyBook = ThisWorkbook

    FileNm = ThisWorkbook.Path & "\" & "tester.xlsm"
    Application.Workbooks.Open (C:\Users\Sue Loh\Documents\"Cost Schedule.xlsm"

    With newBook
       
        'Trying to add my copied text from (Worksheet named Estimate1) in here
       
        .SaveAs Filename:=FileNm, FileFormat:=52, CreateBackup:=False

        .Close Savechanges:=False
    End With
End Sub
 
Hi Sue ,

A couple of points :

1. The closing parenthesis is missing in the statement :

Application.Workbooks.Open (C:\Users\Sue Loh\Documents\"Cost Schedule.xlsm"

2. The variable newBook is not defined.

First ensure this segment of code works without any problem ; once this is done , you can just incorporate the earlier code into this at the place you have marked as the insertion point.

Narayan
 
This is why I'm asking for help I dont know how to fix it, I have looked on this site and others and am trying to make it to suit my macro I copied it from another post.
 
Hi Sue ,

OK. Can you answer the following questions ?

1. Where will the macro EstimatetoWorkSchedule reside ?

2. Once you have copied data from the Estimate1 worksheet to the Works Schedule worksheet , do you want this workbook to be saved ?

3. Do you want the entire Works Schedule worksheet to be copied to the Cost Schedule.xlsm workbook ?

4. If there is already a tab named Works Schedule in the file Cost Schedule.xlsm , will that tab be replaced by the new worksheet ?

5. Do you want the updated file Cost Schedule.xlsm to be saved or should it be given a new name ?

Narayan
 
1. C:\Users\Sue Loh\Documents

2. Workbook to be saved but the Works Schedule worksheet could be deleted after it is copied to Cost Schedule I only using the Work Schedule worksheet to compile all my data be it is transferred to Cost Schedule.

3. All the data from Work Schedule Worksheet to be copied and prefer to have 2 blank rows added above as this Cost Schedule will be updated everyday

4. No it will need to be add to a Work Schedule that gets updated everyday.

5. Always saved and it does need to be closed I prefer it to stay open so I can work on that after it is updated.

Thanks for the questions
 
Hi Sue ,

A few more clarifications are required !

The first line mentions a folder ( C:\Users\Sue Loh\Documents ) ; I was looking for a file name ; in which workbook does the macro EstimatetoWorkSchedule reside ?

I don't understand the second clarification ; do you want the worksheet Works Schedule to be transferred to the Cost Schedule.xlsm workbook through a sheet copy / move , or do you want all the cells in the Works Schedule worksheet to be copied to its counterpart in the Cost Schedule.xlsm workbook ?

What is the role of the file tester.xlsm ? If you upload the Cost Schedule.xlsm workbook , things will be very clear.

Narayan
 
I hope these files are self explanatory.
 

Attachments

  • Tester.xlsm
    623.2 KB · Views: 6
  • Cost Schedule.xlsm
    12.1 KB · Views: 6
You must log in or register to reply here.
Back
Top