Need to edit macro in multiple workbooks to output data to master workbook

**batador** · 07-07-2013, 03:41 PM

Ok, I will try to explain as best I can. I have a workbook with multiple sheets in it. I have a macro in this workbook that looks at all the sheets and an sql server and puts data into a single sheet within the workbook. I want to make copies of this workbook and distribute it to three of my co-workers. When they click a button I have inserted into the workbook to run the macro, I want all of our data to output to a master workbook. I do not know how to script the file path name and what not into the macro. I can't post the workbook due to network security restrictions here at work so I will answer any follow up questions as best I can and I will copy and paste the code directly into the forum space. Any and all help is greatly appreciated.

Sub Update_Names()
'
' Update_Names Macro
' Macro recorded 5/18/2010 by ********
' Edited 05/13/13 by ********
'   'Inserting Columns************************************

    Sheets("Batch").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    'Range("A2:C2").Select
    Selection.Interior.ColorIndex = 2
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With

    Sheets("Chem-Prep").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Selection.Interior.ColorIndex = 2
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With

    Sheets("Furnace").Select
    Rows("2:3").Select
    Selection.Insert Shift:=xlDown
    Selection.Interior.ColorIndex = 2
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With

    Sheets("Pack-Out").Select
    Rows("2:4").Select
    Selection.Insert Shift:=xlDown
    Selection.Interior.ColorIndex = 2
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With

    Sheets("Quality Lab").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Selection.Interior.ColorIndex = 2
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With

    'Copying data into the forming tab**************************

      Sheets("Forming").Select
    Sheets("Forming").Select
If Range("A2").Value <> vbNullString Then
Rows("2:17").Insert Shift:=x1Down
Else
    End If

    Sheets("Data Entry").Select
    Range("F75:F82").Select
    Selection.Copy
    Sheets("Forming").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Data Entry").Select
    Range("F85:F92").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Forming").Select
    Range("A10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("Data Entry").Select
    Range("D95:G95").Select
    Selection.Copy
    Sheets("Chem-Prep").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Data Entry").Select
    Range("D98:G98").Select
    Selection.Copy
    Sheets("Quality Lab").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Data Entry").Select
    Range("D101:G101").Select
    Selection.Copy
    Sheets("Batch").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Data Entry").Select
    Range("D104:H107").Select
    Selection.Copy
    Sheets("Pack-Out").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B15").Select
    Sheets("Data Entry").Select
    Range("D109:H110").Select
    Selection.Copy
    Sheets("Furnace").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C7").Select
    Sheets("Data Entry").Select
    Range("D3").Select

    'Getting data from SQL server**********

Dim strSQL As String
Dim V_Beg_Date As String
Dim V_End_Date As String

V_Beg_Date = Sheets("Data Entry").Range("D3")
V_End_Date = Sheets("Data Entry").Range("D4")

            Sheets("Forming").Select
            Range("B1").Select

        strSQL = "SELECT TIMESTAMP, CHOPPER, SHIFT_CODE 'Shift', OE , "
        strSQL = strSQL & "CE, BBOH, HTB, "
        strSQL = strSQL & "CHOP_CHECK_PCT 'Chop Check %'"
        strSQL = strSQL & "From dbo.SHIFT_SUMM_CHPRDATA2 "
        strSQL = strSQL & "Where ""timestamp"" >= '" & V_Beg_Date & "' "
        strSQL = strSQL & "and ""timestamp"" < '" & V_End_Date & "'"

server = "ODBC;DSN=*******"

With ActiveSheet.QueryTables.Add(server, _
          Destination:=Range("B1"))
          .Sql = (strSQL)
          .FieldNames = True
          .RefreshStyle = xlInsertDeleteCells
          .RefreshStyle = x1OverWriteCells
          .RowNumbers = False
          .FillAdjacentFormulas = False
          .RefreshOnFileOpen = False
          .HasAutoFormat = True
          .BackgroundQuery = True
          .TablesOnlyFromHTML = True
          .Refresh BackgroundQuery:=False
          .SavePassword = True
          .SaveData = True
      End With

**batador** · 07-11-2013, 05:37 PM

Ok, so I learned how to open another workbook from inside VBA. Now everything works pretty well until I get to where I copy my data in one workbook and try and paste it into the other master workbook. I receive an error that says:

Run-time error '1004':
Insert Method of Range of Class Failed

It also highlights exactly where it is failing. The code that is highlighted is some code that runs perfectly well within the script before it has to go out and open the master workbook. I'm a failing to understand. Anyone got any ideas?

**batador** · 07-16-2013, 05:05 PM

I have moved beyond the method of range class failed problem and have now encountered a PasteSpecial Method of Range Class Failed error now. I think what is happening is that by the time I get my master workbook opened and try to paste the copied data, the copied data isn't there to paste anymore. I think I may need to re-write the code somehow, but I am not sure how to write it. Can anyone take a look and point me in the right direction? And I apologize for the sloppy coding, still very green with this and I am learning. I have highlighted in red where I get the error message.

Sub Update_Names()
'
' Update_Names Macro
' Macro recorded 5/18/2010 by ********
' Edited 5/13/13 by ******** Added code to pull data from SQL
' Edited 7/8/13 by ******** Added code to open master workbook and insert data
'   'Inserting Columns************************************
    
    
  
    
    Sheets("Batch").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    'Range("A2:C2").Select
    Selection.Interior.ColorIndex = 2
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    
    Sheets("Chem-Prep").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Selection.Interior.ColorIndex = 2
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    
    Sheets("Furnace").Select
    Rows("2:3").Select
    Selection.Insert Shift:=xlDown
    Selection.Interior.ColorIndex = 2
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    
    Sheets("Pack-Out").Select
    Rows("2:4").Select
    Selection.Insert Shift:=xlDown
    Selection.Interior.ColorIndex = 2
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    
    Sheets("Quality Lab").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Selection.Interior.ColorIndex = 2
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    
    'Copying data into the sliving tab**************************
   
    
If Range("A2").Value <> vbNullString Then
Rows("2:17").Insert Shift:=x1Down
Else
    End If
    
    
    
    Sheets("Data Entry").Select
    Range("F75:F82").Select
    Selection.Copy
    Sheets("Forming").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Data Entry").Select
    Range("F85:F92").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Forming").Select
    Range("A10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Data Entry").Select
    Range("D95:G95").Select
    Selection.Copy
    Sheets("Chem-Prep").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Data Entry").Select
    Range("D98:G98").Select
    Selection.Copy
    Sheets("Quality Lab").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Data Entry").Select
    Range("D101:G101").Select
    Selection.Copy
    Sheets("Batch").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Data Entry").Select
    Range("D104:H107").Select
    Selection.Copy
    Sheets("Pack-Out").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B15").Select
    Sheets("Data Entry").Select
    Range("D109:H110").Select
    Selection.Copy
    Sheets("Furnace").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C7").Select
    Sheets("Data Entry").Select
    Range("D3").Select
    
    'Getting data from SQL server**********
            
Dim strSQL As String
Dim V_Beg_Date As String
Dim V_End_Date As String
    
V_Beg_Date = Sheets("Data Entry").Range("D3")
V_End_Date = Sheets("Data Entry").Range("D4")

    
   
   
            Sheets("Forming").Select
            Range("B1").Select
             
        
        strSQL = "SELECT TIMESTAMP, CHOPPER, SHIFT_CODE 'Shift', OE , "
        strSQL = strSQL & "CE, BBOH, HTB, "
        strSQL = strSQL & "CHOP_CHECK_PCT 'Chop Check %'"
        strSQL = strSQL & "From dbo.SHIFT_SUMM_CHPRDATA2 "
        strSQL = strSQL & "Where ""timestamp"" >= '" & V_Beg_Date & "' "
        strSQL = strSQL & "and ""timestamp"" < '" & V_End_Date & "'"




server = "ODBC;DSN=******"

With ActiveSheet.QueryTables.Add(server, _
          Destination:=Range("B1"))
          .Sql = (strSQL)
          .FieldNames = True
          .RefreshStyle = xlInsertDeleteCells
          .RefreshStyle = x1OverWriteCells
          .RowNumbers = False
          .FillAdjacentFormulas = False
          .RefreshOnFileOpen = False
          .HasAutoFormat = True
          .BackgroundQuery = True
          .TablesOnlyFromHTML = True
          .Refresh BackgroundQuery:=False
          .SavePassword = True
          .SaveData = True
         End With
         
        
        Sheets("Forming").Select
        Range("A2:I17").Select
        Selection.Copy
        ActiveWorkbook.Save
        
        
        Workbooks.Open Filename:= _
        "P:\Common\Support Team\Team Leaders\A Team\Production Scheduling.xls"
         Sheets("Forming").Select
         
    If Range("A2").Value <> vbNullString Then
        Rows("2:17").Insert Shift:=x1Down
        Else
        
    End If
    
         Sheets("Forming").Select
         Range("A2").Select
       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False            
         ActiveWorkbook.Save
      ' ActiveWorkbook.SaveAs Filename:= _
       ' "P:\Common\Support Team\Team Leaders\A Team\Production Scheduling.xls", _
         FileFormat:=xlExcel12, CreateBackup:=False
    ActiveWindow.Close

**xladept** · 07-16-2013, 07:24 PM

Hi Batador,

I've rewritten much of your routine - see if it still works:

Sub Update_Names(): Dim ws As Worksheet, R As Range, wo As Worksheet
'
' Update_Names Macro
' Macro recorded 5/18/2010 by ********
' Edited 5/13/13 by ******** Added code to pull data from SQL
' Edited 7/8/13 by ******** Added code to open master workbook and insert data
'   'Inserting Columns************************************
    
    Set ws = Sheets("Batch"): Set R = ws.Rows("2:2")
    R.Insert Shift:=xlDown: R.Interior.ColorIndex = 2
    GoSub LetFont
    
    Set ws = Sheets("Chem-Prep"): Set R = ws.Rows("2:2")
    R.Insert Shift:=xlDown: R.Interior.ColorIndex = 2
    GoSub LetFont
    
    Set ws = Sheets("Furnace"): Set R = ws.Rows("2:3")
    R.Insert Shift:=xlDown: R.Interior.ColorIndex = 2
    GoSub LetFont
    
    Set ws = Sheets("Pack-Out"): Set R = ws.Rows("2:4")
    R.Insert Shift:=xlDown: R.Interior.ColorIndex = 2
    GoSub LetFont
    
    Set ws = Sheets("Quality Lab"): Set R = ws.Rows("2:2")
    R.Insert Shift:=xlDown: R.Interior.ColorIndex = 2
    GoSub LetFont
                    'Copying data into the sliving tab**************************
ws.Activate
    
If Range("A2").Value <> vbNullString Then
Rows("2:17").Insert Shift:=xlDown
Else
    End If
    
    Set ws = Sheets("Data Entry"): Set R = ws.Range("F75:F82"): Set wo = Sheets("Forming")
                        R.Copy: wo.Range("A2").PasteSpecial xlPasteValues
                                Application.CutCopyMode = False
                                
    Set R = ws.Range("F85:F92"): R.Copy: wo.Range("A10").PasteSpecial xlPasteValues
   
    Set R = ws.Range("D95:G95"): Set wo = Sheets("Chem-Prep")
                    R.Copy: wo.Range("A2").PasteSpecial xlPasteValues
    
    Set R = ws.Range("D98:G98"): Set wo = Sheets("Quality Lab")
                    R.Copy: wo.Range("A2").PasteSpecial xlPasteValues
                    
    Set R = ws.Range("D101:G101"): Set wo = Sheets("Batch")
                    R.Copy: wo.Range("A2").PasteSpecial xlPasteValues
                    
    Set R = ws.Range("D104:G107"): Set wo = Sheets("Pack-Out")
                    R.Copy: wo.Range("A2").PasteSpecial xlPasteValues
    
    Set R = ws.Range("D109:H110"): Set wo = Sheets("Furnace")
                    R.Copy: wo.Range("A2").PasteSpecial xlPasteValues
    
    'Getting data from SQL server**********
            
Dim strSQL As String
Dim V_Beg_Date As String
Dim V_End_Date As String
    
V_Beg_Date = ws.Range("D3")
V_End_Date = ws.Range("D4")

            Sheets("Forming").Select
            Range("B1").Select
             
        
        strSQL = "SELECT TIMESTAMP, CHOPPER, SHIFT_CODE 'Shift', OE , "
        strSQL = strSQL & "CE, BBOH, HTB, "
        strSQL = strSQL & "CHOP_CHECK_PCT 'Chop Check %'"
        strSQL = strSQL & "From dbo.SHIFT_SUMM_CHPRDATA2 "
        strSQL = strSQL & "Where ""timestamp"" >= '" & V_Beg_Date & "' "
        strSQL = strSQL & "and ""timestamp"" < '" & V_End_Date & "'"

server = "ODBC;DSN=******"

With ActiveSheet.QueryTables.Add(server, _
          destination:=Range("B1"))
          .Sql = (strSQL)
          .FieldNames = True
          .RefreshStyle = xlInsertDeleteCells
          .RefreshStyle = x1OverWriteCells
          .RowNumbers = False
          .FillAdjacentFormulas = False
          .RefreshOnFileOpen = False
          .HasAutoFormat = True
          .BackgroundQuery = True
          .TablesOnlyFromHTML = True
          .Refresh BackgroundQuery:=False
          .SavePassword = True
          .SaveData = True
         End With
         
        Set ws = Sheets("Forming"): Set R = ws.Range("A2:I17")
                    ActiveWorkbook.Save
        
        
        Workbooks.Open fileName:= _
        "P:\Common\Support Team\Team Leaders\A Team\Production Scheduling.xls"
         Sheets("Forming").Select
         
    If Range("A2").Value <> vbNullString Then
        Rows("2:17").Insert Shift:=x1Down
        Else
        
    End If
        Set wo = ActiveWorkbook.Sheets("Forming")
        R.Copy: wo.Range("A2").PasteSpecial
                    ActiveWorkbook.Close True
      ' ActiveWorkbook.SaveAs Filename:= _
       ' "P:\Common\Support Team\Team Leaders\A Team\Production Scheduling.xls", _
         FileFormat:=xlExcel12, CreateBackup:=False
    
                            Exit Sub
LetFont:
    With R.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With: Return
    
    
    
    End Sub

**batador** · 07-16-2013, 08:00 PM

Re-written much hell! You re-wrote the whole thing! We went from riding in a Pinto to a Ferrari right there! It looks great and works great too. Thank you so very much. It looks really clean and I can actually decipher what you did. I feel ashamed now even posting what I had cobbled together. I can learn a lot from this. I will mark as solved as soon as I figure out how to! Thanks again!