Pasting some values and some formulas to a new workbook with VBA

[mattpaynenyc]

Hello all,

First post, so here it goes:

I'm eliminating some double data entry at work and cleaning up some neglected spreadsheets from years past. I had a lot of success with the first project, but am stuck on this one. Basically, I'm making a macro that will export a week-ending report based on a date the user inputs in a cell. The macro needs to copy and paste the row labels (from column A) and then find and copy and paste the appropriate data based on the desired date. Not terribly difficult in theory. Where I'm stuck is that I can get everything pasted into the new workbook, but I would like for a number of the cells to have formulas (e.g. cells that total a row or column, or compute the cost percentage). That way, if our bookkeeper changes the sheet after it's been exported, it will still be correct.

The number of cells that need formulas makes it impractical to do each manually, and I thought about do a number of smaller ranges but that would require quite a bit of flipping back and forth between workbooks. I could do something simpler like

workbook2.range(y) = workbook1.range(x)

but again, that seems clunky since there would be a lot of them. That may end up being the path of least resistance though.

To make matters harder, there are a few cells that contains formulas on the original sheet that do need to be pasted as values on the new one. That eliminates using an "if the cell contains a formula, then..." sort of method I think.

Here's what I'm working with. I'm not an expert, by any means, so forgive any sloppy code or logic. I've italicized the line that I was hoping would do the trick. Alas, I get a "Ranges aren't the same size" type error.

Any help is greatly appreciated!

Sub Export_Weekly_Beverage()

    
    ' Create Variables
    
    Dim newFileName As String 'The new file name of the exported file, including it's directory
    Dim rowTitles As Range 'Where we will store the row titles
    Dim WEData As Range 'Where we will store the week ending data
    Dim startColumn As String 'Will be the starting column of WE data
    Dim endColumn As String 'Will be the ending column of WE data
    Dim c As Range 'Holder Variable
    Dim cEnd As Integer 'Column number of the last column in the data range
    Dim cStart As Integer 'Column number of the first copy in the data range
    Dim cStartLetter As String 'First column's letter
    Dim cEndLetter As String 'Last column's letter
    Dim directory As String 'Where the new workbook gets saved
    Dim newBookName As String 'The new file name

    directory = Worksheets("Troubleshooting").Cells(9, "C")
    newFileName = Worksheets("Troubleshooting").Cells(9, "B")
        
    'Assign the row titles to the variable
    Set rowTitles = ActiveWorkbook.Sheets("Beverage Puchases").Range("A1:A200")
    
    'Find the column for the week-ending date and assign cEnd and cStart as the first and last columns in the range
    With ActiveWorkbook.Sheets("Beverage Puchases").Range("A4:QQ4")
        Set c = .Find(What:=ActiveWorkbook.Sheets("Weekly Reports").Cells(3, "D"), LookIn:=xlValues)
        If Not c Is Nothing Then
            cEnd = c.Column + 1
            cStart = c.Column - 6
        End If
    End With
    
    'Convert the column numbers to letters
    If cStart > 26 Then
        cStartLetter = Chr(Int((cStart - 1) / 26) + 64) & Chr(((cStart - 1) Mod 26) + 65)
    Else
        cStartLetter = Chr(cStart + 64)
    End If
    
    If cEnd > 26 Then
        cEndLetter = Chr(Int((cEnd - 1) / 26) + 64) & Chr(((cEnd - 1) Mod 26) + 65)
    Else
        cEndLetter = Chr(cEnd + 64)
    End If
    
    'Set the second range with data to be copied
    Set WEData = ActiveWorkbook.Sheets("Beverage Puchases").Range(cStartLetter & "1:" & cEndLetter & "200")
    
    'Copy the Row titles
    rowTitles.Copy
    
    'Open a new workbook
    Workbooks.Add
    
    'Assign the new book's name to a variable
    newBookName = ActiveWorkbook.Name
    
    
    'Paste the row titles
    Sheets("Sheet1").Range("A1:A200").PasteSpecial xlPasteColumnWidths
    Sheets("Sheet1").Range("A1:A200").PasteSpecial xlPasteFormats
    Sheets("Sheet1").Range("A1:A200").PasteSpecial xlPasteValuesAndNumberFormats
    
    
    'Switch back to the Sales workbook
    ThisWorkbook.Activate
    
    'Copy the week ending data
    WEData.Copy
    
    'Switch back to the new workbook
    Workbooks(newBookName).Activate
    
    'Paste the data
    Sheets("Sheet1").Range("B1:I200").PasteSpecial xlPasteColumnWidths
    Sheets("Sheet1").Range("B1:I200").PasteSpecial xlPasteFormats
    Sheets("Sheet1").Range("B1:I200").PasteSpecial xlPasteValuesAndNumberFormats
    
    'Paste the formulas for the exported file
    [I]Sheets("Sheet1").Range("I6:I200,B16:H16,B18:H18,B21:H22,B34:H34,B36:H36,B39:H40,B52:H52,B54:H54,B56:H56,B59:H60,B72:H72,B74:H74,B77:H78,B80:H94").PasteSpecial xlPasteFormulas[/I]
    
    'Reset the new workbook before closing
    Range("A1").Select
    Application.CutCopyMode = False
    
    'If the directory for saving doesn't exist, create it
    If Len(Dir(directory, vbDirectory)) = 0 Then
        MkDir directory
    End If
    
    'Save and close the new workbook
    ActiveWorkbook.SaveAs Filename:=newFileName
    ActiveWorkbook.Close
    
    'Reset the workbook that's still open
    Range("A1").Select
    Application.CutCopyMode = False


End Sub

 

[mattpaynenyc]

Bump. Any ideas?