Question

There are multiple defined ranges that I am copying and pasting from one workbook to another. The code that I have written opens a workbook that is defined as a variable, copies certain cells, switches to "thisworkbook" and pastes the cells. I have more cells that I would like to copy from the workbook defined as a variable but can't figure out how to "switch". I do not want to open the workbook 3 separate times. How do I get around the .open line?

Thank you

Sub MDVwk1()
'turn off screen refreshing
Application.ScreenUpdating = False

'pick the correct timesheet
TimeSheetMDV1 = Application.GetOpenFilename

'Opens the workbook chosen for MDV week 1

Workbooks.Open TimeSheetMDV1
'Copies the project number cells and pastes them in the workbook under week 1 for MDV
Range("B5:B100").Copy
ThisWorkbook.Sheets("Mark").Activate
'Pastes the copied cells
Range("B10").PasteSpecial (xlPasteValues)

'copies the project total hours from MDV Wk1
Workbooks.Open TimeSheetMDV1 'THIS IS THE FIRST OPEN THAT I WANT TO ELIMINATE
Range("L5:L100").Copy

'Paste the copied cells
ThisWorkbook.Sheets("Mark").Activate
Range("C10").PasteSpecial (xlPasteValues)

'opening the time sheet again to close it
Workbooks.Open TimeSheetMDV1
ActiveWorkbook.Close savechanges:=False

'center the columns
Columns("B:C").HorizontalAlignment = xlCenter
End Sub
Was it helpful?

Solution

Try this code:

Sub MDVwk1()
    Dim wb As Workbook
    Dim TimeSheetMDV1
    Dim ws As Worksheet

    'turn off screen refreshing
    Application.ScreenUpdating = False

    'pick the correct timesheet
    TimeSheetMDV1 = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", 1, "Choose Excel file")

    'if user doen't press cancel
    If TimeSheetMDV1 <> False Then

        'Opens the workbook chosen for MDV week 1
        On Error Resume Next
        Set wb = Workbooks.Open(TimeSheetMDV1)
        On Error GoTo 0
        'if workbook is succesfully opened
        If Not wb Is Nothing Then
            Set ws = ThisWorkbook.Sheets("Mark")
            With wb
                .Range("B5:B100").Copy
                ws.Range("B10").PasteSpecial xlPasteValues

                .Range("L5:L100").Copy
                ws.Range("C10").PasteSpecial xlPasteValues
            End With
            'Copies the project number cells and pastes them in the workbook under week 1 for MDV

            wb.Close SaveChanges:=False
            Set wb = Nothing

            'center the columns
            ws.Range("B:C").HorizontalAlignment = xlCenter
        End If
    End If
    Application.ScreenUpdating = True
End Sub

Note how this code opens workbook:

Dim wb As Workbook
'....
Set wb = Workbooks.Open(TimeSheetMDV1)

now you can use wb variable to work with opened workbook.

Also I made some improvements:

1) I've added filter for the file formats in GetOpenFilename:

TimeSheetMDV1 = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", 1, "Choose Excel file")

2) If user pressed "CANCEL", TimeSheetMDV1 would be False and thats why I added this If statement:

If TimeSheetMDV1 <> False Then
   'do sth
End if

3) I've also added special variable for your worksheet:

Dim ws As Worksheet
'...
Set ws = ThisWorkbook.Sheets("Mark")
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top