Hello, I'm trying to implement a macro that would loop trough files in a folder you can select every time the macro is ran. Maybe someone could Help? I am not that familiar with code yet. The main task for it is to paste special the all the sheets (Some don't need) so that the formula disappears and after that delete columns N and forward and then move to the next workbook until it's done
I got a file of multiple (50) Excels that should sent to customers. For each one now I have pasted special so that the formula is removed from the cells and after that deleted unnecessary columns with sensitive information like pricing or notes. I would need the macro to first open a workbook in the selected folder. Then paste special (formula removed from whole sheet) and do that for each sheet in workbook with few exceptions. After that repeat the process but for deleting columns from N - AA for each sheet. After that close workbook and repeat for all files in the selected file.
Here's some macros that I like and could be useful (Maybe combining them and making them compatible with each other would work?):
Dim strPath As String Dim xStrFile1, xStrFile2 As String Dim xWbk As Workbook Dim xSFD, xRFD As FileDialog Dim xSPath As String Dim xRPath, xWBName As String Dim xBol As Boolean Set xSFD = Application.FileDialog(msoFileDialogFolderPicker) With xSFD .Title = "Please select the folder contains the Excel files you want to convert:" .InitialFileName = "C:\" End With
Code: Avoiding certain sheet names
Sub Sheet_ExportPDF(wb As Workbook, fname As String) 'Purpose: determine sheets to be exported to pdf 'store base workbook name Dim baseWB As String baseWB = fname 'user to define what names to avoid by adding to string Const NTA As String = "Byers_Green_hinnasto,Var_Str_Cev_hinnasto,Hinnasto, 0.0.2022, 00.01.1900, Client Unspecified-13, Toll-hinnasto, Ei käytössä2, Ei käytössä, Ajot_01, Ajot_02, Ajot_03, Ajot_03, Ajot_04, Ajot_05, Ajot_06, Ajot_07, Ajot_08, Ajot_09, Ajot_10, Ajot_11, Ajot_12, Steveco" 'build array of names to avoid Dim NamesToAvoid As Variant NamesToAvoid = Split(NTA, ",") 'process visible worksheets and compare to NamesToAvoid, export the 'sheets that are not in conflict with user's list to avoid Dim ws As Worksheet, blnConflict As Boolean, i As Long For Each ws In wb.Worksheets 'determine if sheet is visible If ws.Visible = xlSheetVisible Then 'loop through user's list to avoid For i = LBound(NamesToAvoid) To UBound(NamesToAvoid) 'if on the avoidance list, set bln and exit loop If UCase(ws.Name) = Trim(UCase(NamesToAvoid(i))) Then blnConflict = True Exit For End If Next i 'process appropriate safe sheets fname = baseWB & "_" & ws.Name & ".pdf" If Not blnConflict Then ExportPDF ws, fname Else blnConflict = False End If Next ws End Sub
Sub RemoveFormulas() 'This will copy/paste all values in the entire workbook (with option for hidden sheets) Application.ScreenUpdating = False Dim Sh As Worksheet Dim Q1, Q2 As Integer Q1 = MsgBox("Would you like to remove all formulas from this workbook?", _ vbQuestion + vbYesNo) If Q1 = vbNo Then Exit Sub If Q1 = vbYes Then Q2 = MsgBox("Would you like to include hidden worksheets?", _ vbQuestion + vbYesNo) If Q2 = vbYes Then For Each Sh In ActiveWorkbook.Worksheets Sh.Activate Sh.Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues Sh.Range("A1").Select Next Sh End If If Q2 = vbNo Then For Each Sh In ActiveWorkbook.Worksheets If Sh.Visible = True Then Sh.Activate Sh.Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues Sh.Range("A1").Select End If Next Sh End If Application.CutCopyMode = False Application.ScreenUpdating = True End SubSub LoopAllFilesInFolder()
Dim wb As Workbook Dim myPath As String Dim myFile As String Dim myExtension As String Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual myPath = "your path\" myExtension = "*.xls*" myFile = Dir(myPath & myExtension) Do While myFile <> "" If Len(myFile) = 0 Then Exit Do Set wb = Workbooks.Open(Filename:=myPath & myFile) Columns("R:S").EntireColumn.Delete wb.Close SaveChanges:=True myFile = Dir Loop 'Message Box when tasks are completed MsgBox "Task Complete!" ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub