Firstly a massive thank you for the help from this forum, I've been handed the following today as well, which is a little out of my zone, but I am trying to learn it. I have the following code in a sheet
Into this I need to add that the sheets the user selects are saved as a PDF to a folder that is named after the cell in column a that is the row it is appended to, in the same location as this log is kept I've recorded this -
Option Explicit Sub copySheet() Dim ChangeRequestBooks() As Workbook Application.ScreenUpdating = False ChangeRequestBooks = openFiles() If ChangeRequestBooks(0) Is Nothing Then MsgBox "Update Cancelled" Else processFiles ChangeRequestBooks MsgBox "Update Complete" End If Application.ScreenUpdating = True End Sub ' Prompts the user for a list of files and returns a referece (in an array) to all the files. ' Opens all the files ready to be processed. Function openFiles() As Workbook() Dim Wb() As Workbook Dim i As Long, c As Long Dim FilesToOpen As Variant ' tell the user what we want them to do MsgBox "Select workbook(s) to copy.", vbApplicationModal ' note that if you want to have the open dialogue start in a specific folder then ' use ChDrive and ChDir (uncoment following section and update it to the correct path) 'ChDrive "H:" ' note that if used on multiple systems the drive letter isn't always the same 'ChDir "H:\1. Finance Shared Services\FINANCE DATA & MI CHANGE\Financial Risk MI Change\Change Request Forms Recived" ' is the folder spelt wrong? Recived or Received? ' prompt the user with an open dialog FilesToOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel (*.xl*),*.xl*", Title:="Please select all change request files required", MultiSelect:=True) If Not IsArray(FilesToOpen) Then ReDim openFiles(0) Exit Function End If For i = LBound(FilesToOpen) To UBound(FilesToOpen) ReDim Preserve Wb(c) ' need to create a space in the array for the file we're about to open Set Wb(c) = Workbooks.Open(FileName:=FilesToOpen(i), UpdateLinks:=False, ReadOnly:=True) c = c + 1 Next i openFiles = Wb End Function Private Sub processFiles(Wb() As Workbook) Dim i As Long Dim ws As Worksheet Dim SourceRange As range, TargetRange As range Set ws = ThisWorkbook.Worksheets("SummarySheet") Set TargetRange = ws.Cells(ws.Cells.Rows.Count, 2) Set TargetRange = TargetRange.End(xlUp) Set TargetRange = TargetRange.Cells(2, 1) For i = LBound(Wb) To UBound(Wb) With Wb(i) If .Worksheets.Count >= 2 Then Set ws = .Worksheets(2) Set SourceRange = ws.Cells(2, 2) Set SourceRange = ws.range(SourceRange, SourceRange.End(xlToRight)) SourceRange.Copy TargetRange.PasteSpecial xlPasteValues Application.CutCopyMode = False Set TargetRange = TargetRange.Cells(2, 1) Else MsgBox "Filename: '" & .Name & "', is missing the sheet we need. Skipping it." End If ' close the file we've finished with it now .Close SaveChanges:=False ' false to not attempt to save changes (and not prompt the user for it) End With Next i ' by this point all the files that were opened should be closed and we should be looking at the completed SummarySheet table End Sub
I can recognize the save as section I'll be putting the publish to false as there could be multiple uploads at the same time so it would slow the process down a little I think. Could you help me in terms of how I would go about this? Fully appreciate this is big ask or at least feels like for me I’m afraid Thank you for any help And apologies for missing one of the most important rules
Option Explicit Sub Macro1() ' ' Macro1 Macro ' ' ChDir _ "H:\1. Finance Shared Services\FINANCE DATA & MI CHANGE\Financial Risk MI Change\Change Request Forms Recived" Workbooks.Open Filename:= _ "Same as above with filename" Range("H10:J10").Select ChDir _ "Same as above but with the filename on were its being saved" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "H:\1. Finance Shared Services\FINANCE DATA & MI CHANGE\Financial Risk MI Change\Change Request Forms Recived\FS & MI 2\Change Request Form.pdf" _ , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=True Range("Q26").Select ActiveWindow.Close End Sub
This question generated 38 answers. To proceed to the answers, click here.
This thread is current as of February 14, 2014.