Opening a workbook and copying pages to master workbook











up vote
0
down vote

favorite












I have this code which opens 2 workbooks, copies a sheet and paste then to the master workbook. It is currently taking 3 minutes. Can this be done quicker (i.e. without opening each workbook to copy)?



It takes roughly 3 minutes to do.



Sub Load()
Dim masterWB As Workbook
Dim dailyWB As Workbook
Dim lastweekWB As Workbook
Dim R As Range
Dim B As Range
Dim C As Range
Dim Lrow As Long

Application.DisplayAlerts = False

'Set Current Workbook as Master
Set masterWB = Application.ThisWorkbook
'Set some Workbook as the one you are copying from
Set dailyWB = Workbooks.Open(Sheets("Control Manager").Range("O2"))

'Copy the Range from dailyWB and Paste it into the MasterWB
dailyWB.Sheets("Summary1").Range("A1:BJ200").Copy masterWB.Sheets("Summary").Range("A1").Rows("1:1")
'formatting and paste as values
masterWB.Activate
Worksheets("Summary").Select
'trim values
Columns("A:BJ").Select
Selection.Columns.AutoFit
Selection.Copy
Selection.PasteSpecial xlPasteValues

'repeat for next Sheet
dailyWB.Sheets("risk1").Range("A1:BB200").Copy masterWB.Sheets("risk").Range("A1").Rows("1:1")
'formatting and paste as values'
masterWB.Activate
Worksheets("risk").Select
Columns("A:BB").Select
With Application.WorksheetFunction
For Each B In Intersect(Columns("A:BB"), ActiveSheet.UsedRange)
B.Value = .Trim(B.Value)
Next B
End With
Selection.Columns.AutoFit
Selection.Copy
Selection.PasteSpecial xlPasteValues

'repeat for CS sheet
dailyWB.Sheets("CS today").Range("A1:L3").Copy masterWB.Sheets("CS").Range("A1").Rows("1:1")
'formatting and paste as values
masterWB.Activate
Worksheets("CS").Select
Columns("A:L").Select
'trim cells to exclude spaces.
With Application.WorksheetFunction
For Each R In Intersect(Columns("A:L"), ActiveSheet.UsedRange)
R.Value = .Trim(R.Value)
Next R
End With
Selection.Columns.AutoFit
Selection.Copy
Selection.PasteSpecial xlPasteValues

''''''''''''Get Last Week Data''''''''''''''''''''''

Set lastweekWB = Workbooks.Open(Sheets("Control Manager").Range("O3"))

'repeat for next risk Sheet
lastweekWB.Sheets("risk2").Range("A1:BB200").Copy masterWB.Sheets("risk_lastweek").Range("A1").Rows("1:1")
'formatting and paste as values

masterWB.Activate
Worksheets("risk_lastweek").Select
Columns("A:BB").Select
With Application.WorksheetFunction
For Each B In Intersect(Columns("A:BB"), ActiveSheet.UsedRange)
B.Value = .Trim(B.Value)
Next B
End With
Selection.Columns.AutoFit
Selection.Copy
Selection.PasteSpecial xlPasteValues

Application.DisplayAlerts = True

'Close the Workbook without saving
dailyWB.Close False
lastweekWB.Close False
'Clear the Variables
Set dailyWB = Nothing
Set masterWB = Nothing
Set lastweekWB = Nothing
End Sub









share|improve this question




























    up vote
    0
    down vote

    favorite












    I have this code which opens 2 workbooks, copies a sheet and paste then to the master workbook. It is currently taking 3 minutes. Can this be done quicker (i.e. without opening each workbook to copy)?



    It takes roughly 3 minutes to do.



    Sub Load()
    Dim masterWB As Workbook
    Dim dailyWB As Workbook
    Dim lastweekWB As Workbook
    Dim R As Range
    Dim B As Range
    Dim C As Range
    Dim Lrow As Long

    Application.DisplayAlerts = False

    'Set Current Workbook as Master
    Set masterWB = Application.ThisWorkbook
    'Set some Workbook as the one you are copying from
    Set dailyWB = Workbooks.Open(Sheets("Control Manager").Range("O2"))

    'Copy the Range from dailyWB and Paste it into the MasterWB
    dailyWB.Sheets("Summary1").Range("A1:BJ200").Copy masterWB.Sheets("Summary").Range("A1").Rows("1:1")
    'formatting and paste as values
    masterWB.Activate
    Worksheets("Summary").Select
    'trim values
    Columns("A:BJ").Select
    Selection.Columns.AutoFit
    Selection.Copy
    Selection.PasteSpecial xlPasteValues

    'repeat for next Sheet
    dailyWB.Sheets("risk1").Range("A1:BB200").Copy masterWB.Sheets("risk").Range("A1").Rows("1:1")
    'formatting and paste as values'
    masterWB.Activate
    Worksheets("risk").Select
    Columns("A:BB").Select
    With Application.WorksheetFunction
    For Each B In Intersect(Columns("A:BB"), ActiveSheet.UsedRange)
    B.Value = .Trim(B.Value)
    Next B
    End With
    Selection.Columns.AutoFit
    Selection.Copy
    Selection.PasteSpecial xlPasteValues

    'repeat for CS sheet
    dailyWB.Sheets("CS today").Range("A1:L3").Copy masterWB.Sheets("CS").Range("A1").Rows("1:1")
    'formatting and paste as values
    masterWB.Activate
    Worksheets("CS").Select
    Columns("A:L").Select
    'trim cells to exclude spaces.
    With Application.WorksheetFunction
    For Each R In Intersect(Columns("A:L"), ActiveSheet.UsedRange)
    R.Value = .Trim(R.Value)
    Next R
    End With
    Selection.Columns.AutoFit
    Selection.Copy
    Selection.PasteSpecial xlPasteValues

    ''''''''''''Get Last Week Data''''''''''''''''''''''

    Set lastweekWB = Workbooks.Open(Sheets("Control Manager").Range("O3"))

    'repeat for next risk Sheet
    lastweekWB.Sheets("risk2").Range("A1:BB200").Copy masterWB.Sheets("risk_lastweek").Range("A1").Rows("1:1")
    'formatting and paste as values

    masterWB.Activate
    Worksheets("risk_lastweek").Select
    Columns("A:BB").Select
    With Application.WorksheetFunction
    For Each B In Intersect(Columns("A:BB"), ActiveSheet.UsedRange)
    B.Value = .Trim(B.Value)
    Next B
    End With
    Selection.Columns.AutoFit
    Selection.Copy
    Selection.PasteSpecial xlPasteValues

    Application.DisplayAlerts = True

    'Close the Workbook without saving
    dailyWB.Close False
    lastweekWB.Close False
    'Clear the Variables
    Set dailyWB = Nothing
    Set masterWB = Nothing
    Set lastweekWB = Nothing
    End Sub









    share|improve this question


























      up vote
      0
      down vote

      favorite









      up vote
      0
      down vote

      favorite











      I have this code which opens 2 workbooks, copies a sheet and paste then to the master workbook. It is currently taking 3 minutes. Can this be done quicker (i.e. without opening each workbook to copy)?



      It takes roughly 3 minutes to do.



      Sub Load()
      Dim masterWB As Workbook
      Dim dailyWB As Workbook
      Dim lastweekWB As Workbook
      Dim R As Range
      Dim B As Range
      Dim C As Range
      Dim Lrow As Long

      Application.DisplayAlerts = False

      'Set Current Workbook as Master
      Set masterWB = Application.ThisWorkbook
      'Set some Workbook as the one you are copying from
      Set dailyWB = Workbooks.Open(Sheets("Control Manager").Range("O2"))

      'Copy the Range from dailyWB and Paste it into the MasterWB
      dailyWB.Sheets("Summary1").Range("A1:BJ200").Copy masterWB.Sheets("Summary").Range("A1").Rows("1:1")
      'formatting and paste as values
      masterWB.Activate
      Worksheets("Summary").Select
      'trim values
      Columns("A:BJ").Select
      Selection.Columns.AutoFit
      Selection.Copy
      Selection.PasteSpecial xlPasteValues

      'repeat for next Sheet
      dailyWB.Sheets("risk1").Range("A1:BB200").Copy masterWB.Sheets("risk").Range("A1").Rows("1:1")
      'formatting and paste as values'
      masterWB.Activate
      Worksheets("risk").Select
      Columns("A:BB").Select
      With Application.WorksheetFunction
      For Each B In Intersect(Columns("A:BB"), ActiveSheet.UsedRange)
      B.Value = .Trim(B.Value)
      Next B
      End With
      Selection.Columns.AutoFit
      Selection.Copy
      Selection.PasteSpecial xlPasteValues

      'repeat for CS sheet
      dailyWB.Sheets("CS today").Range("A1:L3").Copy masterWB.Sheets("CS").Range("A1").Rows("1:1")
      'formatting and paste as values
      masterWB.Activate
      Worksheets("CS").Select
      Columns("A:L").Select
      'trim cells to exclude spaces.
      With Application.WorksheetFunction
      For Each R In Intersect(Columns("A:L"), ActiveSheet.UsedRange)
      R.Value = .Trim(R.Value)
      Next R
      End With
      Selection.Columns.AutoFit
      Selection.Copy
      Selection.PasteSpecial xlPasteValues

      ''''''''''''Get Last Week Data''''''''''''''''''''''

      Set lastweekWB = Workbooks.Open(Sheets("Control Manager").Range("O3"))

      'repeat for next risk Sheet
      lastweekWB.Sheets("risk2").Range("A1:BB200").Copy masterWB.Sheets("risk_lastweek").Range("A1").Rows("1:1")
      'formatting and paste as values

      masterWB.Activate
      Worksheets("risk_lastweek").Select
      Columns("A:BB").Select
      With Application.WorksheetFunction
      For Each B In Intersect(Columns("A:BB"), ActiveSheet.UsedRange)
      B.Value = .Trim(B.Value)
      Next B
      End With
      Selection.Columns.AutoFit
      Selection.Copy
      Selection.PasteSpecial xlPasteValues

      Application.DisplayAlerts = True

      'Close the Workbook without saving
      dailyWB.Close False
      lastweekWB.Close False
      'Clear the Variables
      Set dailyWB = Nothing
      Set masterWB = Nothing
      Set lastweekWB = Nothing
      End Sub









      share|improve this question















      I have this code which opens 2 workbooks, copies a sheet and paste then to the master workbook. It is currently taking 3 minutes. Can this be done quicker (i.e. without opening each workbook to copy)?



      It takes roughly 3 minutes to do.



      Sub Load()
      Dim masterWB As Workbook
      Dim dailyWB As Workbook
      Dim lastweekWB As Workbook
      Dim R As Range
      Dim B As Range
      Dim C As Range
      Dim Lrow As Long

      Application.DisplayAlerts = False

      'Set Current Workbook as Master
      Set masterWB = Application.ThisWorkbook
      'Set some Workbook as the one you are copying from
      Set dailyWB = Workbooks.Open(Sheets("Control Manager").Range("O2"))

      'Copy the Range from dailyWB and Paste it into the MasterWB
      dailyWB.Sheets("Summary1").Range("A1:BJ200").Copy masterWB.Sheets("Summary").Range("A1").Rows("1:1")
      'formatting and paste as values
      masterWB.Activate
      Worksheets("Summary").Select
      'trim values
      Columns("A:BJ").Select
      Selection.Columns.AutoFit
      Selection.Copy
      Selection.PasteSpecial xlPasteValues

      'repeat for next Sheet
      dailyWB.Sheets("risk1").Range("A1:BB200").Copy masterWB.Sheets("risk").Range("A1").Rows("1:1")
      'formatting and paste as values'
      masterWB.Activate
      Worksheets("risk").Select
      Columns("A:BB").Select
      With Application.WorksheetFunction
      For Each B In Intersect(Columns("A:BB"), ActiveSheet.UsedRange)
      B.Value = .Trim(B.Value)
      Next B
      End With
      Selection.Columns.AutoFit
      Selection.Copy
      Selection.PasteSpecial xlPasteValues

      'repeat for CS sheet
      dailyWB.Sheets("CS today").Range("A1:L3").Copy masterWB.Sheets("CS").Range("A1").Rows("1:1")
      'formatting and paste as values
      masterWB.Activate
      Worksheets("CS").Select
      Columns("A:L").Select
      'trim cells to exclude spaces.
      With Application.WorksheetFunction
      For Each R In Intersect(Columns("A:L"), ActiveSheet.UsedRange)
      R.Value = .Trim(R.Value)
      Next R
      End With
      Selection.Columns.AutoFit
      Selection.Copy
      Selection.PasteSpecial xlPasteValues

      ''''''''''''Get Last Week Data''''''''''''''''''''''

      Set lastweekWB = Workbooks.Open(Sheets("Control Manager").Range("O3"))

      'repeat for next risk Sheet
      lastweekWB.Sheets("risk2").Range("A1:BB200").Copy masterWB.Sheets("risk_lastweek").Range("A1").Rows("1:1")
      'formatting and paste as values

      masterWB.Activate
      Worksheets("risk_lastweek").Select
      Columns("A:BB").Select
      With Application.WorksheetFunction
      For Each B In Intersect(Columns("A:BB"), ActiveSheet.UsedRange)
      B.Value = .Trim(B.Value)
      Next B
      End With
      Selection.Columns.AutoFit
      Selection.Copy
      Selection.PasteSpecial xlPasteValues

      Application.DisplayAlerts = True

      'Close the Workbook without saving
      dailyWB.Close False
      lastweekWB.Close False
      'Clear the Variables
      Set dailyWB = Nothing
      Set masterWB = Nothing
      Set lastweekWB = Nothing
      End Sub






      vba






      share|improve this question















      share|improve this question













      share|improve this question




      share|improve this question








      edited 1 hour ago









      Jamal

      30.2k11115226




      30.2k11115226










      asked 10 hours ago









      excelguy

      447




      447






















          1 Answer
          1






          active

          oldest

          votes

















          up vote
          0
          down vote













          Separating tasks into multiple subroutines will make the code easier to test and modify.



          This video: Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset) will explain why you rarely need to Select or Activate an Object.



          I would use .Range("A1") instead of .Range("A1").Rows("1:1") because Range.Copy targets the first cell in the destination.



          Refactored Code



          Sub Load()
          LoadDailyWorkbook
          LoadLastWeeksWorkbook
          End Sub

          Sub LoadDailyWorkbook()
          Const A1BJ200 As String = "A1:BJ200"
          Const A1L3 As String = "A1:L3"
          Dim masterWB As Workbook
          Dim dailyWB As Workbook
          'Set Current Workbook as Master
          Set masterWB = Application.ThisWorkbook
          'Set some Workbook as the one you are copying from
          Set dailyWB = getWorkbook(Sheets("Control Manager").Range("O2"))

          If Not dailyWB Is Nothing Then
          With dailyWB
          'Copy the Range from dailyWB and Paste it into the MasterWB
          .Worksheets("Summary1").Range(A1BJ200).Copy masterWB.Worksheets("Summary").Range("A1")
          TrimRange masterWB.Worksheets("Summary").Range(A1BJ200)
          'repeat for next Sheet
          .Worksheets("risk1").Range(A1BJ200).Copy masterWB.Worksheets("risk").Range("A1")
          TrimRange masterWB.Worksheets("risk").Range(A1BJ200)

          'repeat for CS sheet
          .Worksheets("CS today").Range(A1L3).Copy masterWB.Worksheets("CS").Range("A1").Rows("1:1")
          TrimRange masterWB.Worksheets("CS").Range(A1L3)
          .Close SaveChanges:=False
          End With

          End If
          End Sub

          Sub LoadLastWeeksWorkbook()
          Const A1BJ200 As String = "A1:BJ200"
          Dim masterWB As Workbook
          Dim lastweekWB As Workbook

          'Set Current Workbook as Master
          Set masterWB = Application.ThisWorkbook

          ''''''''''''Get Last Week Data''''''''''''''''''''''
          Set lastweekWB = getWorkbook(Workbooks.Open(Sheets("Control Manager").Range("O3")))
          If Not lastweekWB Is Nothing Then
          With lastweekWB
          'repeat for next risk Sheet
          .Worksheets("risk2").Range(A1BJ200).Copy masterWB.Worksheets("risk_lastweek").Range("A1")
          TrimRange masterWB.Worksheets("risk_lastweek").Range(A1BJ200)

          TrimRange masterWB.Columns("A:BB")
          .Close SaveChanges:=False
          End With
          End If
          End Sub

          Function getWorkbook(FullName As String) As Workbook
          If Len(Dir(FullName)) = 0 Then
          MsgBox FullName & " not found found", vbCritical, "File Not Found"
          Else
          Set getWorkbook = Workbooks.Open(FullName)
          End If
          End Function

          Sub TrimRange(Target As Range)
          Dim results As Variant
          Set Target = Intersect(Target.Parent.UsedRange, Target)
          If Target Is Nothing Then
          Exit Sub
          ElseIf Target.Count = 1 Then
          Target.Value = Trim(Target.Value)
          Exit Sub
          Else
          Target = Target.Value

          Dim r As Long, c As Long
          For r = 1 To UBound(results)
          For c = 1 To UBound(results, 2)
          results(r, c) = Trim(results(r, c))
          Next
          Next
          Target.Value = results
          End If
          Target.Columns.EntireColumn.AutoFit
          End Sub





          share|improve this answer























          • thanks for this, getting type mismatch error on Set Target = Intersect(Target.Parent, Target)
            – excelguy
            6 hours ago










          • @excelguy I updated the code. Should have been Target.Parent.UsedRange.
            – TinMan
            6 hours ago










          • overflow error now lol, Target = Target.Value
            – excelguy
            6 hours ago










          • Hmmm....I've been writing javascript so I put Else If instead of ElseIf but it should be a syntax error. I don't know why you would get an overflow error.
            – TinMan
            4 hours ago











          Your Answer





          StackExchange.ifUsing("editor", function () {
          return StackExchange.using("mathjaxEditing", function () {
          StackExchange.MarkdownEditor.creationCallbacks.add(function (editor, postfix) {
          StackExchange.mathjaxEditing.prepareWmdForMathJax(editor, postfix, [["\$", "\$"]]);
          });
          });
          }, "mathjax-editing");

          StackExchange.ifUsing("editor", function () {
          StackExchange.using("externalEditor", function () {
          StackExchange.using("snippets", function () {
          StackExchange.snippets.init();
          });
          });
          }, "code-snippets");

          StackExchange.ready(function() {
          var channelOptions = {
          tags: "".split(" "),
          id: "196"
          };
          initTagRenderer("".split(" "), "".split(" "), channelOptions);

          StackExchange.using("externalEditor", function() {
          // Have to fire editor after snippets, if snippets enabled
          if (StackExchange.settings.snippets.snippetsEnabled) {
          StackExchange.using("snippets", function() {
          createEditor();
          });
          }
          else {
          createEditor();
          }
          });

          function createEditor() {
          StackExchange.prepareEditor({
          heartbeatType: 'answer',
          convertImagesToLinks: false,
          noModals: true,
          showLowRepImageUploadWarning: true,
          reputationToPostImages: null,
          bindNavPrevention: true,
          postfix: "",
          imageUploader: {
          brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
          contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
          allowUrls: true
          },
          onDemand: true,
          discardSelector: ".discard-answer"
          ,immediatelyShowMarkdownHelp:true
          });


          }
          });














          draft saved

          draft discarded


















          StackExchange.ready(
          function () {
          StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fcodereview.stackexchange.com%2fquestions%2f209548%2fopening-a-workbook-and-copying-pages-to-master-workbook%23new-answer', 'question_page');
          }
          );

          Post as a guest















          Required, but never shown

























          1 Answer
          1






          active

          oldest

          votes








          1 Answer
          1






          active

          oldest

          votes









          active

          oldest

          votes






          active

          oldest

          votes








          up vote
          0
          down vote













          Separating tasks into multiple subroutines will make the code easier to test and modify.



          This video: Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset) will explain why you rarely need to Select or Activate an Object.



          I would use .Range("A1") instead of .Range("A1").Rows("1:1") because Range.Copy targets the first cell in the destination.



          Refactored Code



          Sub Load()
          LoadDailyWorkbook
          LoadLastWeeksWorkbook
          End Sub

          Sub LoadDailyWorkbook()
          Const A1BJ200 As String = "A1:BJ200"
          Const A1L3 As String = "A1:L3"
          Dim masterWB As Workbook
          Dim dailyWB As Workbook
          'Set Current Workbook as Master
          Set masterWB = Application.ThisWorkbook
          'Set some Workbook as the one you are copying from
          Set dailyWB = getWorkbook(Sheets("Control Manager").Range("O2"))

          If Not dailyWB Is Nothing Then
          With dailyWB
          'Copy the Range from dailyWB and Paste it into the MasterWB
          .Worksheets("Summary1").Range(A1BJ200).Copy masterWB.Worksheets("Summary").Range("A1")
          TrimRange masterWB.Worksheets("Summary").Range(A1BJ200)
          'repeat for next Sheet
          .Worksheets("risk1").Range(A1BJ200).Copy masterWB.Worksheets("risk").Range("A1")
          TrimRange masterWB.Worksheets("risk").Range(A1BJ200)

          'repeat for CS sheet
          .Worksheets("CS today").Range(A1L3).Copy masterWB.Worksheets("CS").Range("A1").Rows("1:1")
          TrimRange masterWB.Worksheets("CS").Range(A1L3)
          .Close SaveChanges:=False
          End With

          End If
          End Sub

          Sub LoadLastWeeksWorkbook()
          Const A1BJ200 As String = "A1:BJ200"
          Dim masterWB As Workbook
          Dim lastweekWB As Workbook

          'Set Current Workbook as Master
          Set masterWB = Application.ThisWorkbook

          ''''''''''''Get Last Week Data''''''''''''''''''''''
          Set lastweekWB = getWorkbook(Workbooks.Open(Sheets("Control Manager").Range("O3")))
          If Not lastweekWB Is Nothing Then
          With lastweekWB
          'repeat for next risk Sheet
          .Worksheets("risk2").Range(A1BJ200).Copy masterWB.Worksheets("risk_lastweek").Range("A1")
          TrimRange masterWB.Worksheets("risk_lastweek").Range(A1BJ200)

          TrimRange masterWB.Columns("A:BB")
          .Close SaveChanges:=False
          End With
          End If
          End Sub

          Function getWorkbook(FullName As String) As Workbook
          If Len(Dir(FullName)) = 0 Then
          MsgBox FullName & " not found found", vbCritical, "File Not Found"
          Else
          Set getWorkbook = Workbooks.Open(FullName)
          End If
          End Function

          Sub TrimRange(Target As Range)
          Dim results As Variant
          Set Target = Intersect(Target.Parent.UsedRange, Target)
          If Target Is Nothing Then
          Exit Sub
          ElseIf Target.Count = 1 Then
          Target.Value = Trim(Target.Value)
          Exit Sub
          Else
          Target = Target.Value

          Dim r As Long, c As Long
          For r = 1 To UBound(results)
          For c = 1 To UBound(results, 2)
          results(r, c) = Trim(results(r, c))
          Next
          Next
          Target.Value = results
          End If
          Target.Columns.EntireColumn.AutoFit
          End Sub





          share|improve this answer























          • thanks for this, getting type mismatch error on Set Target = Intersect(Target.Parent, Target)
            – excelguy
            6 hours ago










          • @excelguy I updated the code. Should have been Target.Parent.UsedRange.
            – TinMan
            6 hours ago










          • overflow error now lol, Target = Target.Value
            – excelguy
            6 hours ago










          • Hmmm....I've been writing javascript so I put Else If instead of ElseIf but it should be a syntax error. I don't know why you would get an overflow error.
            – TinMan
            4 hours ago















          up vote
          0
          down vote













          Separating tasks into multiple subroutines will make the code easier to test and modify.



          This video: Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset) will explain why you rarely need to Select or Activate an Object.



          I would use .Range("A1") instead of .Range("A1").Rows("1:1") because Range.Copy targets the first cell in the destination.



          Refactored Code



          Sub Load()
          LoadDailyWorkbook
          LoadLastWeeksWorkbook
          End Sub

          Sub LoadDailyWorkbook()
          Const A1BJ200 As String = "A1:BJ200"
          Const A1L3 As String = "A1:L3"
          Dim masterWB As Workbook
          Dim dailyWB As Workbook
          'Set Current Workbook as Master
          Set masterWB = Application.ThisWorkbook
          'Set some Workbook as the one you are copying from
          Set dailyWB = getWorkbook(Sheets("Control Manager").Range("O2"))

          If Not dailyWB Is Nothing Then
          With dailyWB
          'Copy the Range from dailyWB and Paste it into the MasterWB
          .Worksheets("Summary1").Range(A1BJ200).Copy masterWB.Worksheets("Summary").Range("A1")
          TrimRange masterWB.Worksheets("Summary").Range(A1BJ200)
          'repeat for next Sheet
          .Worksheets("risk1").Range(A1BJ200).Copy masterWB.Worksheets("risk").Range("A1")
          TrimRange masterWB.Worksheets("risk").Range(A1BJ200)

          'repeat for CS sheet
          .Worksheets("CS today").Range(A1L3).Copy masterWB.Worksheets("CS").Range("A1").Rows("1:1")
          TrimRange masterWB.Worksheets("CS").Range(A1L3)
          .Close SaveChanges:=False
          End With

          End If
          End Sub

          Sub LoadLastWeeksWorkbook()
          Const A1BJ200 As String = "A1:BJ200"
          Dim masterWB As Workbook
          Dim lastweekWB As Workbook

          'Set Current Workbook as Master
          Set masterWB = Application.ThisWorkbook

          ''''''''''''Get Last Week Data''''''''''''''''''''''
          Set lastweekWB = getWorkbook(Workbooks.Open(Sheets("Control Manager").Range("O3")))
          If Not lastweekWB Is Nothing Then
          With lastweekWB
          'repeat for next risk Sheet
          .Worksheets("risk2").Range(A1BJ200).Copy masterWB.Worksheets("risk_lastweek").Range("A1")
          TrimRange masterWB.Worksheets("risk_lastweek").Range(A1BJ200)

          TrimRange masterWB.Columns("A:BB")
          .Close SaveChanges:=False
          End With
          End If
          End Sub

          Function getWorkbook(FullName As String) As Workbook
          If Len(Dir(FullName)) = 0 Then
          MsgBox FullName & " not found found", vbCritical, "File Not Found"
          Else
          Set getWorkbook = Workbooks.Open(FullName)
          End If
          End Function

          Sub TrimRange(Target As Range)
          Dim results As Variant
          Set Target = Intersect(Target.Parent.UsedRange, Target)
          If Target Is Nothing Then
          Exit Sub
          ElseIf Target.Count = 1 Then
          Target.Value = Trim(Target.Value)
          Exit Sub
          Else
          Target = Target.Value

          Dim r As Long, c As Long
          For r = 1 To UBound(results)
          For c = 1 To UBound(results, 2)
          results(r, c) = Trim(results(r, c))
          Next
          Next
          Target.Value = results
          End If
          Target.Columns.EntireColumn.AutoFit
          End Sub





          share|improve this answer























          • thanks for this, getting type mismatch error on Set Target = Intersect(Target.Parent, Target)
            – excelguy
            6 hours ago










          • @excelguy I updated the code. Should have been Target.Parent.UsedRange.
            – TinMan
            6 hours ago










          • overflow error now lol, Target = Target.Value
            – excelguy
            6 hours ago










          • Hmmm....I've been writing javascript so I put Else If instead of ElseIf but it should be a syntax error. I don't know why you would get an overflow error.
            – TinMan
            4 hours ago













          up vote
          0
          down vote










          up vote
          0
          down vote









          Separating tasks into multiple subroutines will make the code easier to test and modify.



          This video: Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset) will explain why you rarely need to Select or Activate an Object.



          I would use .Range("A1") instead of .Range("A1").Rows("1:1") because Range.Copy targets the first cell in the destination.



          Refactored Code



          Sub Load()
          LoadDailyWorkbook
          LoadLastWeeksWorkbook
          End Sub

          Sub LoadDailyWorkbook()
          Const A1BJ200 As String = "A1:BJ200"
          Const A1L3 As String = "A1:L3"
          Dim masterWB As Workbook
          Dim dailyWB As Workbook
          'Set Current Workbook as Master
          Set masterWB = Application.ThisWorkbook
          'Set some Workbook as the one you are copying from
          Set dailyWB = getWorkbook(Sheets("Control Manager").Range("O2"))

          If Not dailyWB Is Nothing Then
          With dailyWB
          'Copy the Range from dailyWB and Paste it into the MasterWB
          .Worksheets("Summary1").Range(A1BJ200).Copy masterWB.Worksheets("Summary").Range("A1")
          TrimRange masterWB.Worksheets("Summary").Range(A1BJ200)
          'repeat for next Sheet
          .Worksheets("risk1").Range(A1BJ200).Copy masterWB.Worksheets("risk").Range("A1")
          TrimRange masterWB.Worksheets("risk").Range(A1BJ200)

          'repeat for CS sheet
          .Worksheets("CS today").Range(A1L3).Copy masterWB.Worksheets("CS").Range("A1").Rows("1:1")
          TrimRange masterWB.Worksheets("CS").Range(A1L3)
          .Close SaveChanges:=False
          End With

          End If
          End Sub

          Sub LoadLastWeeksWorkbook()
          Const A1BJ200 As String = "A1:BJ200"
          Dim masterWB As Workbook
          Dim lastweekWB As Workbook

          'Set Current Workbook as Master
          Set masterWB = Application.ThisWorkbook

          ''''''''''''Get Last Week Data''''''''''''''''''''''
          Set lastweekWB = getWorkbook(Workbooks.Open(Sheets("Control Manager").Range("O3")))
          If Not lastweekWB Is Nothing Then
          With lastweekWB
          'repeat for next risk Sheet
          .Worksheets("risk2").Range(A1BJ200).Copy masterWB.Worksheets("risk_lastweek").Range("A1")
          TrimRange masterWB.Worksheets("risk_lastweek").Range(A1BJ200)

          TrimRange masterWB.Columns("A:BB")
          .Close SaveChanges:=False
          End With
          End If
          End Sub

          Function getWorkbook(FullName As String) As Workbook
          If Len(Dir(FullName)) = 0 Then
          MsgBox FullName & " not found found", vbCritical, "File Not Found"
          Else
          Set getWorkbook = Workbooks.Open(FullName)
          End If
          End Function

          Sub TrimRange(Target As Range)
          Dim results As Variant
          Set Target = Intersect(Target.Parent.UsedRange, Target)
          If Target Is Nothing Then
          Exit Sub
          ElseIf Target.Count = 1 Then
          Target.Value = Trim(Target.Value)
          Exit Sub
          Else
          Target = Target.Value

          Dim r As Long, c As Long
          For r = 1 To UBound(results)
          For c = 1 To UBound(results, 2)
          results(r, c) = Trim(results(r, c))
          Next
          Next
          Target.Value = results
          End If
          Target.Columns.EntireColumn.AutoFit
          End Sub





          share|improve this answer














          Separating tasks into multiple subroutines will make the code easier to test and modify.



          This video: Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset) will explain why you rarely need to Select or Activate an Object.



          I would use .Range("A1") instead of .Range("A1").Rows("1:1") because Range.Copy targets the first cell in the destination.



          Refactored Code



          Sub Load()
          LoadDailyWorkbook
          LoadLastWeeksWorkbook
          End Sub

          Sub LoadDailyWorkbook()
          Const A1BJ200 As String = "A1:BJ200"
          Const A1L3 As String = "A1:L3"
          Dim masterWB As Workbook
          Dim dailyWB As Workbook
          'Set Current Workbook as Master
          Set masterWB = Application.ThisWorkbook
          'Set some Workbook as the one you are copying from
          Set dailyWB = getWorkbook(Sheets("Control Manager").Range("O2"))

          If Not dailyWB Is Nothing Then
          With dailyWB
          'Copy the Range from dailyWB and Paste it into the MasterWB
          .Worksheets("Summary1").Range(A1BJ200).Copy masterWB.Worksheets("Summary").Range("A1")
          TrimRange masterWB.Worksheets("Summary").Range(A1BJ200)
          'repeat for next Sheet
          .Worksheets("risk1").Range(A1BJ200).Copy masterWB.Worksheets("risk").Range("A1")
          TrimRange masterWB.Worksheets("risk").Range(A1BJ200)

          'repeat for CS sheet
          .Worksheets("CS today").Range(A1L3).Copy masterWB.Worksheets("CS").Range("A1").Rows("1:1")
          TrimRange masterWB.Worksheets("CS").Range(A1L3)
          .Close SaveChanges:=False
          End With

          End If
          End Sub

          Sub LoadLastWeeksWorkbook()
          Const A1BJ200 As String = "A1:BJ200"
          Dim masterWB As Workbook
          Dim lastweekWB As Workbook

          'Set Current Workbook as Master
          Set masterWB = Application.ThisWorkbook

          ''''''''''''Get Last Week Data''''''''''''''''''''''
          Set lastweekWB = getWorkbook(Workbooks.Open(Sheets("Control Manager").Range("O3")))
          If Not lastweekWB Is Nothing Then
          With lastweekWB
          'repeat for next risk Sheet
          .Worksheets("risk2").Range(A1BJ200).Copy masterWB.Worksheets("risk_lastweek").Range("A1")
          TrimRange masterWB.Worksheets("risk_lastweek").Range(A1BJ200)

          TrimRange masterWB.Columns("A:BB")
          .Close SaveChanges:=False
          End With
          End If
          End Sub

          Function getWorkbook(FullName As String) As Workbook
          If Len(Dir(FullName)) = 0 Then
          MsgBox FullName & " not found found", vbCritical, "File Not Found"
          Else
          Set getWorkbook = Workbooks.Open(FullName)
          End If
          End Function

          Sub TrimRange(Target As Range)
          Dim results As Variant
          Set Target = Intersect(Target.Parent.UsedRange, Target)
          If Target Is Nothing Then
          Exit Sub
          ElseIf Target.Count = 1 Then
          Target.Value = Trim(Target.Value)
          Exit Sub
          Else
          Target = Target.Value

          Dim r As Long, c As Long
          For r = 1 To UBound(results)
          For c = 1 To UBound(results, 2)
          results(r, c) = Trim(results(r, c))
          Next
          Next
          Target.Value = results
          End If
          Target.Columns.EntireColumn.AutoFit
          End Sub






          share|improve this answer














          share|improve this answer



          share|improve this answer








          edited 4 hours ago

























          answered 7 hours ago









          TinMan

          1,007110




          1,007110












          • thanks for this, getting type mismatch error on Set Target = Intersect(Target.Parent, Target)
            – excelguy
            6 hours ago










          • @excelguy I updated the code. Should have been Target.Parent.UsedRange.
            – TinMan
            6 hours ago










          • overflow error now lol, Target = Target.Value
            – excelguy
            6 hours ago










          • Hmmm....I've been writing javascript so I put Else If instead of ElseIf but it should be a syntax error. I don't know why you would get an overflow error.
            – TinMan
            4 hours ago


















          • thanks for this, getting type mismatch error on Set Target = Intersect(Target.Parent, Target)
            – excelguy
            6 hours ago










          • @excelguy I updated the code. Should have been Target.Parent.UsedRange.
            – TinMan
            6 hours ago










          • overflow error now lol, Target = Target.Value
            – excelguy
            6 hours ago










          • Hmmm....I've been writing javascript so I put Else If instead of ElseIf but it should be a syntax error. I don't know why you would get an overflow error.
            – TinMan
            4 hours ago
















          thanks for this, getting type mismatch error on Set Target = Intersect(Target.Parent, Target)
          – excelguy
          6 hours ago




          thanks for this, getting type mismatch error on Set Target = Intersect(Target.Parent, Target)
          – excelguy
          6 hours ago












          @excelguy I updated the code. Should have been Target.Parent.UsedRange.
          – TinMan
          6 hours ago




          @excelguy I updated the code. Should have been Target.Parent.UsedRange.
          – TinMan
          6 hours ago












          overflow error now lol, Target = Target.Value
          – excelguy
          6 hours ago




          overflow error now lol, Target = Target.Value
          – excelguy
          6 hours ago












          Hmmm....I've been writing javascript so I put Else If instead of ElseIf but it should be a syntax error. I don't know why you would get an overflow error.
          – TinMan
          4 hours ago




          Hmmm....I've been writing javascript so I put Else If instead of ElseIf but it should be a syntax error. I don't know why you would get an overflow error.
          – TinMan
          4 hours ago


















          draft saved

          draft discarded




















































          Thanks for contributing an answer to Code Review Stack Exchange!


          • Please be sure to answer the question. Provide details and share your research!

          But avoid



          • Asking for help, clarification, or responding to other answers.

          • Making statements based on opinion; back them up with references or personal experience.


          Use MathJax to format equations. MathJax reference.


          To learn more, see our tips on writing great answers.





          Some of your past answers have not been well-received, and you're in danger of being blocked from answering.


          Please pay close attention to the following guidance:


          • Please be sure to answer the question. Provide details and share your research!

          But avoid



          • Asking for help, clarification, or responding to other answers.

          • Making statements based on opinion; back them up with references or personal experience.


          To learn more, see our tips on writing great answers.




          draft saved


          draft discarded














          StackExchange.ready(
          function () {
          StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fcodereview.stackexchange.com%2fquestions%2f209548%2fopening-a-workbook-and-copying-pages-to-master-workbook%23new-answer', 'question_page');
          }
          );

          Post as a guest















          Required, but never shown





















































          Required, but never shown














          Required, but never shown












          Required, but never shown







          Required, but never shown

































          Required, but never shown














          Required, but never shown












          Required, but never shown







          Required, but never shown







          Popular posts from this blog

          404 Error Contact Form 7 ajax form submitting

          How to know if a Active Directory user can login interactively

          TypeError: fit_transform() missing 1 required positional argument: 'X'