sparkytech
Board Regular
- Joined
- Mar 6, 2018
- Messages
- 96
- Office Version
- 365
- 2019
I have the following code that exports a "master" sheet to an "export" sheet which is stored on a network share, and everything works fine. How can I also add the function to save this same export sheet to a SharePoint share? I also have VBA in the master sheet which colors cells that have been changed to yellow, but these colors don't copy to the export sheet. I would like this to copy cell colors contained in the table columns B:Y in this export if possible. Thanks!
VBA Code:
Sub ExportCleanExcel(control As IRibbonControl)
'Exports the information in the master sheet to a chosen excel file;
'will just move the data without macros or other extra features
Dim FileToOpen As Variant
Dim DestWkb As Workbook
Dim MasBotRow As Long
Dim CurrentDir As String
'Turn off screen updates to improve performance
With Application
.ScreenUpdating = False: .DisplayAlerts = False
End With
CurrentDir = CurDir
ChDrive "T:\Project Spreadsheets\2022"
ChDir "T:\Project Spreadsheets\2022"
'Allows user to select a file to export to using the traditional open file window
FileToOpen = Application.GetOpenFilename("All Excel Files (*.xls?), *.xls?", , "Please export file")
'If the user selects cancel when choosing a file to open FileToOpen is set to FALSE
'Using this we can check if a file was actually selected before continuing
If FileToOpen <> False Then
'Find the bottom row and last column of the table on the master sheet
'MasBotRow = Sheet1.Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
Set MasBotRow variable to row 2500
MasBotRow = 2500
'Open the file that was selected and then set that workbook as DestWkb
Set DestWkb = Application.Workbooks.Open(FileToOpen)
'Copies rows A5 to W to last row and also Z5 to last row on sheet {skips "X:Y"}
ThisWorkbook.Sheets("Master").Range("A5:W" & MasBotRow).Copy
DestWkb.Sheets(1).Range("A5:W" & MasBotRow).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Master").Range("Z5:Z" & MasBotRow).Copy
DestWkb.Sheets(1).Range("X5:X" & MasBotRow).PasteSpecial xlPasteValues
'Close the data file
DestWkb.Close True
MsgBox "Export Complete", 64, "Export Complete"
End If
ChDir CurrentDir
'Turn back on screen updates
'Turn back on alerts after closing the file
With Application
.ScreenUpdating = True: .DisplayAlerts = True: .CutCopyMode = False
End With
End Sub