Create new folder with current date and move specif files to it

S

SantanaKRE8s

Board Regular
Joined
Jul 11, 2023
Messages
131
Office Version
  1. 365
Platform
  1. Windows
Can someone please help with this VBA, I want to create a new folder with the current date and then move specific files to the new folder.

Sub FSOMoveAllFiles()
Dim FSO As New FileSystemObject
Dim FromPath As String
Dim ToPath As String
Dim FileInFromFolder As Object

FromPath = "H:\Desktop"
MkDir "G:\Branches\VS-SpaceX\Benjamin\FABRINET_THF002\CANCELED POs\FBN CXL REQ" & " " & Format(Now(), "M-DD-YYYY") & ""
ToPath = "G:\Branches\VS-SpaceX\Benjamin\FABRINET_THF002\CANCELED POs\FBN CXL REQ" & " " & Format(Now(), "M-DD-YYYY") & ""

Set FSO = CreateObject("Scripting.FileSystemObject")

For Each FileInFromFolder In FSO.GetFolder(FromPath).Files
FileInFromFolder.Move ToPath
Next FileInFromFolder

End Sub
 

Attachments

  • 2024-04-29 11_51_18-Microsoft Visual Basic for Applications - CXL REQUEST_FBN.xlsm [break] - [...png
    2024-04-29 11_51_18-Microsoft Visual Basic for Applications - CXL REQUEST_FBN.xlsm [break] - [...png
    19.7 KB · Views: 20
Sort by date Sort by votes
rlv01 said:
Can you post your entire code with all modifications for Sub FSOMoveAllFiles() ?

When you do, please try to use code tags like I did above when posting code. It makes your code easier to read and copy.
www.mrexcel.com

How to Post Your VBA Code

Post your VBA code.
www.mrexcel.com www.mrexcel.com
Click to expand...
VBA Code: 
Sub FSOMoveAllFiles()
    Dim FSO As New FileSystemObject                   'early binding of FSO oject
    Dim FromPath As String, ToPath As String, FileInFromFolder As File, DateStr As String, FldrName As String, BasePath As String
    Dim MCnt As Long
    
    DateStr = Format(Now(), "M-DD-YYYY")
    FldrName = "FBN CXL REQ " & DateStr
    BasePath = "G:\Branches\VS-SpaceX\Benjamin\FABRINET_THF002\CANCELED POs\"
    FromPath = "H:\Desktop"
    
    If Not FSO.FolderExists(FromPath) Then
        Debug.Print "Folder '" & FromPath & "' does not exist"
        MsgBox "Folder '" & FromPath & "' does not exist", vbCritical
        Exit Sub
    End If
    
    If Not FSO.FolderExists(BasePath) Then
        Debug.Print "Folder '" & BasePath & "' does not exist"
        MsgBox "Folder '" & BasePath & "' does not exist", vbCritical
        Exit Sub
    End If
    
    ToPath = BasePath & FldrName
    
    If Not FSO.FolderExists(ToPath) Then
        FSO.CreateFolder ToPath
    End If
    
    If Not FSO.FolderExists(ToPath) Then
        Debug.Print "Folder '" & ToPath & "' does not exist"    'optional
        MsgBox "Folder '" & ToPath & "' does not exist" & vbCr & vbCr & "Folder creation unsuccessful", vbCritical    'optional
        Exit Sub
    End If
    
    With FSO.GetFolder(FromPath)
        For Each FileInFromFolder In .Files
            Select Case Trim(Left(FileInFromFolder.Name, 12))
                Case "CANCEL.xlsx", "THF002.xlsx", "FBN CXL REQ"
                    If FSO.FileExists(ToPath & "\" & FileInFromFolder.Name) Then
                        Debug.Print FileInFromFolder.Name
                        Select Case MsgBox("File '" & FileInFromFolder.Name & "' already exists in the destination folder. " & vbCrLf & vbCrLf _
                                & "Do you want to overwrite it?", vbYesNoCancel Or vbQuestion, Application.Name)
                            Case vbYes
                                Kill ToPath
                                FileInFromFolder.Move ToPath
                                MCnt = MCnt + 1
                            Case vbCancel
                                Exit Sub
                        End Select
                    Else
                        FileInFromFolder.Move ToPath
                        MCnt = MCnt + 1
                    End If
            End Select
        Next FileInFromFolder
    End With
    
    MsgBox MCnt & " files moved.", vbInformation
End Sub
 
Upvote 0

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
SantanaKRE8s said:
VBA Code: 
Sub FSOMoveAllFiles()
    Dim FSO As New FileSystemObject                   'early binding of FSO oject
    Dim FromPath As String, ToPath As String, FileInFromFolder As File, DateStr As String, FldrName As String, BasePath As String
    Dim MCnt As Long
  
    DateStr = Format(Now(), "M-DD-YYYY")
    FldrName = "FBN CXL REQ " & DateStr
    BasePath = "G:\Branches\VS-SpaceX\Benjamin\FABRINET_THF002\CANCELED POs\"
    FromPath = "H:\Desktop"
  
    If Not FSO.FolderExists(FromPath) Then
        Debug.Print "Folder '" & FromPath & "' does not exist"
        MsgBox "Folder '" & FromPath & "' does not exist", vbCritical
        Exit Sub
    End If
  
    If Not FSO.FolderExists(BasePath) Then
        Debug.Print "Folder '" & BasePath & "' does not exist"
        MsgBox "Folder '" & BasePath & "' does not exist", vbCritical
        Exit Sub
    End If
  
    ToPath = BasePath & FldrName
  
    If Not FSO.FolderExists(ToPath) Then
        FSO.CreateFolder ToPath
    End If
  
    If Not FSO.FolderExists(ToPath) Then
        Debug.Print "Folder '" & ToPath & "' does not exist"    'optional
        MsgBox "Folder '" & ToPath & "' does not exist" & vbCr & vbCr & "Folder creation unsuccessful", vbCritical    'optional
        Exit Sub
    End If
  
    With FSO.GetFolder(FromPath)
        For Each FileInFromFolder In .Files
            Select Case Trim(Left(FileInFromFolder.Name, 12))
                Case "CANCEL.xlsx", "THF002.xlsx", "FBN CXL REQ"
                    If FSO.FileExists(ToPath & "\" & FileInFromFolder.Name) Then
                        Debug.Print FileInFromFolder.Name
                        Select Case MsgBox("File '" & FileInFromFolder.Name & "' already exists in the destination folder. " & vbCrLf & vbCrLf _
                                & "Do you want to overwrite it?", vbYesNoCancel Or vbQuestion, Application.Name)
                            Case vbYes
                                Kill ToPath
                                FileInFromFolder.Move ToPath
                                MCnt = MCnt + 1
                            Case vbCancel
                                Exit Sub
                        End Select
                    Else
                        FileInFromFolder.Move ToPath
                        MCnt = MCnt + 1
                    End If
            End Select
        Next FileInFromFolder
    End With
  
    MsgBox MCnt & " files moved.", vbInformation
End Sub
Click to expand...
Also adding my Module 1 to see if anything here is interfiering

VBA Code: 
Sub GT_DTA()
'
' GT_DTA Macro
'

'
    Sheets("TTI DATA").Select
    Windows("THF002.xlsx").Activate
    Range("A1:AU2000").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range(Selection, Selection.End(xlUp)).Select
    Windows("CXL REQUEST_FBN.xlsm").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Application.DisplayAlerts = False
           
    Columns("T:T").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("S:S").Select
    Selection.TextToColumns Destination:=Range("S1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    Columns("T:V").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
   
    Columns("A:B").Select
    Selection.EntireColumn.Hidden = True
    Columns("H:H").Select
    Selection.EntireColumn.Hidden = True
    Columns("J:K").Select
    Selection.EntireColumn.Hidden = True
    Columns("N:R").Select
    Selection.EntireColumn.Hidden = True
    Columns("AA:AC").Select
    Selection.EntireColumn.Hidden = True
    Columns("AE:AH").Select
    Selection.EntireColumn.Hidden = True
    Columns("AJ:AU").Select
    Selection.EntireColumn.Hidden = True
   
    Columns("AI:AI").Select
    Selection.Cut
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("Z:Z").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("AB:AB").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
   
    Range("E2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-1])"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E3000")
    Range("E2:E3000").Select
   
    Range("Z1").Select
    ActiveCell.FormulaR1C1 = "Shipped"
    Range("Z1").Select
    Selection.Copy
    Range("Z2:Z3000").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AB2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[1]<""10"",""0"","""")"
    Selection.AutoFill Destination:=Range("AB2:AB3000"), Type:=xlFillDefault
    Columns("AH:AH").Select
    Selection.Copy
    Columns("AY:BB").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
       
    Columns("AY:AY").Select
    Selection.NumberFormat = "General"
    Range("AY2").Select
    ActiveCell.FormulaR1C1 = "=RC[-40]"
    Range("AY2").Select
    Selection.AutoFill Destination:=Range("AY2:AY3000"), Type:=xlFillDefault
    Range("AY2:AY3000").Select
    ActiveWindow.SmallScroll Down:=-1
    Columns("AY:AY").Select
    Selection.NumberFormat = "[$-en-US]d-mmm-yyyy;@"
    Columns("AZ:AZ").Select
    Selection.NumberFormat = "General"
    Range("AZ2").Select
    ActiveCell.FormulaR1C1 = _
        "=RC[-26]&"" ""&TEXT(RC[-25], ""DD-MM-YYYY"")&"",""&"" ""&RC[-27]&"" ""&RC[-18]"
    Range("AZ2").Select
    Selection.AutoFill Destination:=Range("AZ2:AZ3000"), Type:=xlFillDefault
    Range("AZ2:AZ3000").Select
    Columns("BA:BA").Select
    Selection.NumberFormat = "General"
    Range("BA2").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-46],RC[-25],RC[-24])"
    Selection.AutoFill Destination:=Range("BA2:BA3000"), Type:=xlFillDefault
    Range("BA2:BA3000").Select
   
    Columns("BB:BB").Select
    Selection.NumberFormat = "General"
    Range("BB2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-24]"
    Range("BB2").Select
    Selection.AutoFill Destination:=Range("BB2:BB3000"), Type:=xlFillDefault
    Range("BB2:BB3000").Select
        Columns("Y:Y").Select
    Selection.Replace What:="DHIC", Replacement:="DHL", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Columns("Y:Y").Select
    Application.CutCopyMode = False
    Selection.Replace What:="IUSC", Replacement:="UPS", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
       
    Range("AY1").Select
    ActiveCell.FormulaR1C1 = "SUPP COMM ETD"
    Range("AZ1").Select
    ActiveCell.FormulaR1C1 = "SUPP REMARK"
    Range("BA1").Select
    ActiveCell.FormulaR1C1 = "INVOICE NO"
    Range("BB1").Select
    ActiveCell.FormulaR1C1 = "RESALE"
    Range("BB2").Select
   
    Columns("E:E").ColumnWidth = 17
    Columns("AY:AY").ColumnWidth = 17
    Columns("AY:AY").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("AZ:AZ").Select
    Selection.ColumnWidth = 42
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("BA:BA").Select
    Selection.ColumnWidth = 12
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("BB:BB").ColumnWidth = 20.57
    Columns("BB:BB").Select
    Selection.ColumnWidth = 10
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
        Range("AZ1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$BB$3000").AutoFilter Field:=52, Criteria1:= _
        "Shipped       ,"
    Range("AZ2:BA3000").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("AZ1").Select
    ActiveSheet.Range("$A$1:$BB$3000").AutoFilter Field:=52
   
    ActiveSheet.Range("$A$1:$BB$3000").AutoFilter Field:=52, Criteria1:="<>"
    Range("BB2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range(Selection, Selection.End(xlUp)).Select
    ActiveWindow.SmallScroll Down:=-9
    Range("BB1").Select
    ActiveWindow.SmallScroll Down:=-3
    ActiveSheet.Range("$A$1:$BB$3000").AutoFilter Field:=52
   
        Columns("BB:BB").Select
    Selection.Copy
    Columns("BC:BC").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("BA:BA").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("BC:BC").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Application.CutCopyMode = False
    Selection.Cut
    Columns("BA:BA").Select
    ActiveSheet.Paste
    Range("BB2").Select
   
    Columns("C:D").Select
    Selection.EntireColumn.Hidden = True
    Columns("F:AH").Select
    Selection.EntireColumn.Hidden = True
    Columns("BC:DC").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
   
    Sheets("FBN CXL REQ").Select
    Windows("CANCEL.xlsx").Activate
    Range("A1:BD100").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range(Selection, Selection.End(xlUp)).Select
    Windows("CXL REQUEST_FBN.xlsm").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Application.DisplayAlerts = False
           
'   Application.DisplayAlerts = False
    Application.DisplayAlerts = False
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$BD$100"), , xlYes).Name = _
        "Table1"
    Range("Table1[#All]").Select
    ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium2"
    Range("J12").Select
   
    Columns("X:BD").Select
    Selection.Delete Shift:=xlToLeft
    Columns("U:U").Select
    Selection.Delete Shift:=xlToLeft
    Columns("S:S").Select
    Selection.Delete Shift:=xlToLeft
    Columns("Q:Q").Select
    Selection.Delete Shift:=xlToLeft
    Columns("P:P").Select
    Selection.Delete Shift:=xlToLeft
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("A:C").Select
    Selection.Delete Shift:=xlToLeft
   
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("Q:Q").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
   
'   Application.DisplayAlerts = False
    Application.DisplayAlerts = False
    Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=True, OtherChar:= _
        ":", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
        TrailingMinusNumbers:=True
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
   
   
    '   Selection.Merge

    Range("S3:U4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("S5:U6").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
   
    Columns("A").ColumnWidth = 11
    Columns("B").ColumnWidth = 7
    Columns("C").ColumnWidth = 26
    Columns("D").ColumnWidth = 14
    Columns("E").ColumnWidth = 6
    Columns("F").ColumnWidth = 6
    Columns("G").ColumnWidth = 3
    Columns("H").ColumnWidth = 14
    Columns("I").ColumnWidth = 11
    Columns("J").ColumnWidth = 11
    Columns("K").ColumnWidth = 11
    Columns("L").ColumnWidth = 12
    Columns("M").ColumnWidth = 17
    Columns("N").ColumnWidth = 35
    Columns("O").ColumnWidth = 13
    Columns("P").ColumnWidth = 9
    Columns("Q").ColumnWidth = 12
    Columns("R").ColumnWidth = 2
   
    With Worksheets("FBN CXL REQ").Columns("D:F")
    .NumberFormat = "0"
    .Value = .Value
   End With
  
  
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "CUST PN"
    Cells(1, 2).Value = "MFG"
    Cells(1, 3).Value = "PART NUMBER"
    Cells(1, 4).Value = "PO NUMBER"
    Cells(1, 5).Value = "LN"
    Cells(1, 6).Value = "SHIP"
    Cells(1, 7).Value = "."
    Cells(1, 8).Value = "CONCA"
    Cells(1, 9).Value = "QTY"
    Cells(1, 10).Value = "QTY REC"
    Cells(1, 11).Value = "QTY REM"
    Cells(1, 12).Value = "STS BY ETD"
    Cells(1, 13).Value = "SUPP COMM ETD"
    Cells(1, 14).Value = "SUPP REMARK"
    Cells(1, 15).Value = "INVOICE NO"
    Cells(1, 16).Value = "RESALE"
    Cells(1, 17).Value = "LN VALUE"
    Range("S4:U5").Select
    ActiveCell.FormulaR1C1 = "TOTAL"
    Range("S3").Font.Bold = True
    Range("S3").Font.Color = vbWhite
    Range("S3").Font.Size = 20
    Range("S5").Font.Bold = True
    Range("S5").Font.Size = 24
    Range("S5").Select
    Selection.Style = "Currency"
    Range("P:Q").Select
    Selection.Style = "Currency"
    Range("P:P").NumberFormat = "0.0000"
   
    Columns("D:L").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
       
    End With
        Columns("M:O").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
   
        Range("A1:Q1").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

'   RV Color format
    Columns("R:AK").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
   
'   S3 Color Format
        Range("S3:U4").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    Range("S5:U6").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("S3:U6").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 4
        .TintAndShade = 0.399945066682943
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 4
        .TintAndShade = 0.399945066682943
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 4
        .TintAndShade = 0.399945066682943
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 4
        .TintAndShade = 0.399945066682943
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
   
'   Insert (.)
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-3]),"""",""."")"
    Range("G3").Select
   
'   H2 Concatenate Function
    Range("H2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=CONCATENATE([@[PO NUMBER]],[@LN],[@[.]],[@SHIP])"
    Range("H3").Select
   
'   S5 Sum Function
    Range("S5:U6").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C[-2]:R[195]C[-2])"
   
'   Q2 Mult Function
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(ISNUMBER(RC[-1]), ISNUMBER(RC[-6])), RC[-1]*RC[-6], 0)"
    Range("Q3").Select
   

'   Range (M:P) Vlookup Function
    Range("N2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(VLOOKUP(RC[-6],'TTI DATA'!C[-9]:C[38],48,FALSE)),"""",VLOOKUP(RC[-6],'TTI DATA'!C[-9]:C[38],48,FALSE))"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[1]="""",VLOOKUP(RC[-5],'TTI DATA'!C[-8]:C[38],47,FALSE),"""")"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(VLOOKUP(RC[-7],'TTI DATA'!C[-10]:C[38],48,FALSE)),"""",VLOOKUP(RC[-7],'TTI DATA'!C[-10]:C[38],49,FALSE))"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(VLOOKUP(RC[-8],'TTI DATA'!C[-11]:C[38],50,FALSE)),"""",VLOOKUP(RC[-8],'TTI DATA'!C[-11]:C[38],50,FALSE))"
    Columns("M:M").Select
    Selection.NumberFormat = "[$-en-US]d-mmm-yyyy;@"
    Range("Table1[[#Headers],[CUST PN]]").Select
   
   
'   Range("M2:O2") Color format for FBN
    Range("M2:O2").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("Table1[[#Headers],[CUST PN]]").Select
   
'   Columns("G:H,P") Hide
    Columns("G:H").Select
    Selection.EntireColumn.Hidden = True
    Columns("P:P").Select
    Selection.EntireColumn.Hidden = True
   
   
'   Change Color Font to Red
    Range("L2:L100").Select
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Range("S5:U6").Select
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With

'   Range("S3:U4") Change Fill color BLUE
    Range("S3:U4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
   
' Copy Data to New Sheet
Dim sourceSheet As Worksheet
Dim destinationSheet As Worksheet
Dim sourceRange As Range
Set sourceSheet = ThisWorkbook.Sheets("FBN CXL REQ")
Set destinationSheet = ThisWorkbook.Sheets("COMPLETE")
Set sourceRange = sourceSheet.Range("A1:U100")
sourceRange.Copy destinationSheet.Range("A1")

    Sheets("COMPLETE").Select
   
    Columns("A").ColumnWidth = 11
    Columns("B").ColumnWidth = 7
    Columns("C").ColumnWidth = 26
    Columns("D").ColumnWidth = 14
    Columns("E").ColumnWidth = 6
    Columns("F").ColumnWidth = 6
    Columns("G").ColumnWidth = 3
    Columns("H").ColumnWidth = 14
    Columns("I").ColumnWidth = 11
    Columns("J").ColumnWidth = 11
    Columns("K").ColumnWidth = 11
    Columns("L").ColumnWidth = 12
    Columns("M").ColumnWidth = 17
    Columns("N").ColumnWidth = 35
    Columns("O").ColumnWidth = 13
    Columns("P").ColumnWidth = 9
    Columns("Q").ColumnWidth = 12
    Columns("R").ColumnWidth = 2

'
    Range("A2:U2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("R:W").Select
    Application.CutCopyMode = False
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With

    ActiveSheet.ListObjects("Table13").Range.AutoFilter Field:=14, Criteria1:= _
        "Shipped 00-01-1900,"
    ActiveSheet.ListObjects("Table13").Range.AutoFilter Field:=14
    ActiveSheet.ListObjects("Table13").Range.AutoFilter Field:=15, Criteria1:= _
        "0"
    Rows("86:100").Select
    Range("E86").Activate
    Selection.Delete Shift:=xlUp
    Rows("86:1323").Select
    Range("E86").Activate
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    ActiveSheet.ListObjects("Table13").Range.AutoFilter Field:=15
   
'   Color Format S3:U6
    Range("S3:U4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("S5:U6").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With

   
End Sub
 
Upvote 0
And this is my
SantanaKRE8s said:
Also adding my Module 1 to see if anything here is interfiering

VBA Code: 
Sub GT_DTA()
'
' GT_DTA Macro
'

'
    Sheets("TTI DATA").Select
    Windows("THF002.xlsx").Activate
    Range("A1:AU2000").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range(Selection, Selection.End(xlUp)).Select
    Windows("CXL REQUEST_FBN.xlsm").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Application.DisplayAlerts = False
          
    Columns("T:T").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("S:S").Select
    Selection.TextToColumns Destination:=Range("S1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    Columns("T:V").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
  
    Columns("A:B").Select
    Selection.EntireColumn.Hidden = True
    Columns("H:H").Select
    Selection.EntireColumn.Hidden = True
    Columns("J:K").Select
    Selection.EntireColumn.Hidden = True
    Columns("N:R").Select
    Selection.EntireColumn.Hidden = True
    Columns("AA:AC").Select
    Selection.EntireColumn.Hidden = True
    Columns("AE:AH").Select
    Selection.EntireColumn.Hidden = True
    Columns("AJ:AU").Select
    Selection.EntireColumn.Hidden = True
  
    Columns("AI:AI").Select
    Selection.Cut
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("Z:Z").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("AB:AB").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  
    Range("E2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-1])"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E3000")
    Range("E2:E3000").Select
  
    Range("Z1").Select
    ActiveCell.FormulaR1C1 = "Shipped"
    Range("Z1").Select
    Selection.Copy
    Range("Z2:Z3000").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AB2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[1]<""10"",""0"","""")"
    Selection.AutoFill Destination:=Range("AB2:AB3000"), Type:=xlFillDefault
    Columns("AH:AH").Select
    Selection.Copy
    Columns("AY:BB").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
      
    Columns("AY:AY").Select
    Selection.NumberFormat = "General"
    Range("AY2").Select
    ActiveCell.FormulaR1C1 = "=RC[-40]"
    Range("AY2").Select
    Selection.AutoFill Destination:=Range("AY2:AY3000"), Type:=xlFillDefault
    Range("AY2:AY3000").Select
    ActiveWindow.SmallScroll Down:=-1
    Columns("AY:AY").Select
    Selection.NumberFormat = "[$-en-US]d-mmm-yyyy;@"
    Columns("AZ:AZ").Select
    Selection.NumberFormat = "General"
    Range("AZ2").Select
    ActiveCell.FormulaR1C1 = _
        "=RC[-26]&"" ""&TEXT(RC[-25], ""DD-MM-YYYY"")&"",""&"" ""&RC[-27]&"" ""&RC[-18]"
    Range("AZ2").Select
    Selection.AutoFill Destination:=Range("AZ2:AZ3000"), Type:=xlFillDefault
    Range("AZ2:AZ3000").Select
    Columns("BA:BA").Select
    Selection.NumberFormat = "General"
    Range("BA2").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-46],RC[-25],RC[-24])"
    Selection.AutoFill Destination:=Range("BA2:BA3000"), Type:=xlFillDefault
    Range("BA2:BA3000").Select
  
    Columns("BB:BB").Select
    Selection.NumberFormat = "General"
    Range("BB2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-24]"
    Range("BB2").Select
    Selection.AutoFill Destination:=Range("BB2:BB3000"), Type:=xlFillDefault
    Range("BB2:BB3000").Select
        Columns("Y:Y").Select
    Selection.Replace What:="DHIC", Replacement:="DHL", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Columns("Y:Y").Select
    Application.CutCopyMode = False
    Selection.Replace What:="IUSC", Replacement:="UPS", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
      
    Range("AY1").Select
    ActiveCell.FormulaR1C1 = "SUPP COMM ETD"
    Range("AZ1").Select
    ActiveCell.FormulaR1C1 = "SUPP REMARK"
    Range("BA1").Select
    ActiveCell.FormulaR1C1 = "INVOICE NO"
    Range("BB1").Select
    ActiveCell.FormulaR1C1 = "RESALE"
    Range("BB2").Select
  
    Columns("E:E").ColumnWidth = 17
    Columns("AY:AY").ColumnWidth = 17
    Columns("AY:AY").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("AZ:AZ").Select
    Selection.ColumnWidth = 42
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("BA:BA").Select
    Selection.ColumnWidth = 12
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("BB:BB").ColumnWidth = 20.57
    Columns("BB:BB").Select
    Selection.ColumnWidth = 10
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
        Range("AZ1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$BB$3000").AutoFilter Field:=52, Criteria1:= _
        "Shipped       ,"
    Range("AZ2:BA3000").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("AZ1").Select
    ActiveSheet.Range("$A$1:$BB$3000").AutoFilter Field:=52
  
    ActiveSheet.Range("$A$1:$BB$3000").AutoFilter Field:=52, Criteria1:="<>"
    Range("BB2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range(Selection, Selection.End(xlUp)).Select
    ActiveWindow.SmallScroll Down:=-9
    Range("BB1").Select
    ActiveWindow.SmallScroll Down:=-3
    ActiveSheet.Range("$A$1:$BB$3000").AutoFilter Field:=52
  
        Columns("BB:BB").Select
    Selection.Copy
    Columns("BC:BC").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("BA:BA").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("BC:BC").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Application.CutCopyMode = False
    Selection.Cut
    Columns("BA:BA").Select
    ActiveSheet.Paste
    Range("BB2").Select
  
    Columns("C:D").Select
    Selection.EntireColumn.Hidden = True
    Columns("F:AH").Select
    Selection.EntireColumn.Hidden = True
    Columns("BC:DC").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
  
    Sheets("FBN CXL REQ").Select
    Windows("CANCEL.xlsx").Activate
    Range("A1:BD100").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range(Selection, Selection.End(xlUp)).Select
    Windows("CXL REQUEST_FBN.xlsm").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Application.DisplayAlerts = False
          
'   Application.DisplayAlerts = False
    Application.DisplayAlerts = False
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$BD$100"), , xlYes).Name = _
        "Table1"
    Range("Table1[#All]").Select
    ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium2"
    Range("J12").Select
  
    Columns("X:BD").Select
    Selection.Delete Shift:=xlToLeft
    Columns("U:U").Select
    Selection.Delete Shift:=xlToLeft
    Columns("S:S").Select
    Selection.Delete Shift:=xlToLeft
    Columns("Q:Q").Select
    Selection.Delete Shift:=xlToLeft
    Columns("P:P").Select
    Selection.Delete Shift:=xlToLeft
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("A:C").Select
    Selection.Delete Shift:=xlToLeft
  
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("Q:Q").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  
'   Application.DisplayAlerts = False
    Application.DisplayAlerts = False
    Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=True, OtherChar:= _
        ":", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
        TrailingMinusNumbers:=True
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
  
  
    '   Selection.Merge

    Range("S3:U4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("S5:U6").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
  
    Columns("A").ColumnWidth = 11
    Columns("B").ColumnWidth = 7
    Columns("C").ColumnWidth = 26
    Columns("D").ColumnWidth = 14
    Columns("E").ColumnWidth = 6
    Columns("F").ColumnWidth = 6
    Columns("G").ColumnWidth = 3
    Columns("H").ColumnWidth = 14
    Columns("I").ColumnWidth = 11
    Columns("J").ColumnWidth = 11
    Columns("K").ColumnWidth = 11
    Columns("L").ColumnWidth = 12
    Columns("M").ColumnWidth = 17
    Columns("N").ColumnWidth = 35
    Columns("O").ColumnWidth = 13
    Columns("P").ColumnWidth = 9
    Columns("Q").ColumnWidth = 12
    Columns("R").ColumnWidth = 2
  
    With Worksheets("FBN CXL REQ").Columns("D:F")
    .NumberFormat = "0"
    .Value = .Value
   End With
 
 
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "CUST PN"
    Cells(1, 2).Value = "MFG"
    Cells(1, 3).Value = "PART NUMBER"
    Cells(1, 4).Value = "PO NUMBER"
    Cells(1, 5).Value = "LN"
    Cells(1, 6).Value = "SHIP"
    Cells(1, 7).Value = "."
    Cells(1, 8).Value = "CONCA"
    Cells(1, 9).Value = "QTY"
    Cells(1, 10).Value = "QTY REC"
    Cells(1, 11).Value = "QTY REM"
    Cells(1, 12).Value = "STS BY ETD"
    Cells(1, 13).Value = "SUPP COMM ETD"
    Cells(1, 14).Value = "SUPP REMARK"
    Cells(1, 15).Value = "INVOICE NO"
    Cells(1, 16).Value = "RESALE"
    Cells(1, 17).Value = "LN VALUE"
    Range("S4:U5").Select
    ActiveCell.FormulaR1C1 = "TOTAL"
    Range("S3").Font.Bold = True
    Range("S3").Font.Color = vbWhite
    Range("S3").Font.Size = 20
    Range("S5").Font.Bold = True
    Range("S5").Font.Size = 24
    Range("S5").Select
    Selection.Style = "Currency"
    Range("P:Q").Select
    Selection.Style = "Currency"
    Range("P:P").NumberFormat = "0.0000"
  
    Columns("D:L").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
      
    End With
        Columns("M:O").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
  
        Range("A1:Q1").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

'   RV Color format
    Columns("R:AK").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
  
'   S3 Color Format
        Range("S3:U4").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    Range("S5:U6").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("S3:U6").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 4
        .TintAndShade = 0.399945066682943
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 4
        .TintAndShade = 0.399945066682943
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 4
        .TintAndShade = 0.399945066682943
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 4
        .TintAndShade = 0.399945066682943
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
  
'   Insert (.)
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-3]),"""",""."")"
    Range("G3").Select
  
'   H2 Concatenate Function
    Range("H2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=CONCATENATE([@[PO NUMBER]],[@LN],[@[.]],[@SHIP])"
    Range("H3").Select
  
'   S5 Sum Function
    Range("S5:U6").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C[-2]:R[195]C[-2])"
  
'   Q2 Mult Function
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(ISNUMBER(RC[-1]), ISNUMBER(RC[-6])), RC[-1]*RC[-6], 0)"
    Range("Q3").Select
  

'   Range (M:P) Vlookup Function
    Range("N2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(VLOOKUP(RC[-6],'TTI DATA'!C[-9]:C[38],48,FALSE)),"""",VLOOKUP(RC[-6],'TTI DATA'!C[-9]:C[38],48,FALSE))"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[1]="""",VLOOKUP(RC[-5],'TTI DATA'!C[-8]:C[38],47,FALSE),"""")"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(VLOOKUP(RC[-7],'TTI DATA'!C[-10]:C[38],48,FALSE)),"""",VLOOKUP(RC[-7],'TTI DATA'!C[-10]:C[38],49,FALSE))"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(VLOOKUP(RC[-8],'TTI DATA'!C[-11]:C[38],50,FALSE)),"""",VLOOKUP(RC[-8],'TTI DATA'!C[-11]:C[38],50,FALSE))"
    Columns("M:M").Select
    Selection.NumberFormat = "[$-en-US]d-mmm-yyyy;@"
    Range("Table1[[#Headers],[CUST PN]]").Select
  
  
'   Range("M2:O2") Color format for FBN
    Range("M2:O2").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("Table1[[#Headers],[CUST PN]]").Select
  
'   Columns("G:H,P") Hide
    Columns("G:H").Select
    Selection.EntireColumn.Hidden = True
    Columns("P:P").Select
    Selection.EntireColumn.Hidden = True
  
  
'   Change Color Font to Red
    Range("L2:L100").Select
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Range("S5:U6").Select
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With

'   Range("S3:U4") Change Fill color BLUE
    Range("S3:U4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
  
' Copy Data to New Sheet
Dim sourceSheet As Worksheet
Dim destinationSheet As Worksheet
Dim sourceRange As Range
Set sourceSheet = ThisWorkbook.Sheets("FBN CXL REQ")
Set destinationSheet = ThisWorkbook.Sheets("COMPLETE")
Set sourceRange = sourceSheet.Range("A1:U100")
sourceRange.Copy destinationSheet.Range("A1")

    Sheets("COMPLETE").Select
  
    Columns("A").ColumnWidth = 11
    Columns("B").ColumnWidth = 7
    Columns("C").ColumnWidth = 26
    Columns("D").ColumnWidth = 14
    Columns("E").ColumnWidth = 6
    Columns("F").ColumnWidth = 6
    Columns("G").ColumnWidth = 3
    Columns("H").ColumnWidth = 14
    Columns("I").ColumnWidth = 11
    Columns("J").ColumnWidth = 11
    Columns("K").ColumnWidth = 11
    Columns("L").ColumnWidth = 12
    Columns("M").ColumnWidth = 17
    Columns("N").ColumnWidth = 35
    Columns("O").ColumnWidth = 13
    Columns("P").ColumnWidth = 9
    Columns("Q").ColumnWidth = 12
    Columns("R").ColumnWidth = 2

'
    Range("A2:U2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("R:W").Select
    Application.CutCopyMode = False
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With

    ActiveSheet.ListObjects("Table13").Range.AutoFilter Field:=14, Criteria1:= _
        "Shipped 00-01-1900,"
    ActiveSheet.ListObjects("Table13").Range.AutoFilter Field:=14
    ActiveSheet.ListObjects("Table13").Range.AutoFilter Field:=15, Criteria1:= _
        "0"
    Rows("86:100").Select
    Range("E86").Activate
    Selection.Delete Shift:=xlUp
    Rows("86:1323").Select
    Range("E86").Activate
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    ActiveSheet.ListObjects("Table13").Range.AutoFilter Field:=15
  
'   Color Format S3:U6
    Range("S3:U4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("S5:U6").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With

  
End Sub
Click to expand...
Module 2

VBA Code: 
Sub Krea8New()

Dim wbNew As Workbook
Worksheets("COMPLETE").Copy
Set wbNew = ActiveWorkbook
wbNew.SaveAs "H:\Desktop\FBN CXL REQ " & Format(Now(), "MM-DD-YYYY") & ".xlsx", 51

wbNew.Close True

End Sub


and this is an additional module to reset my worbook, to clear all data for next time use.

VBA Code: 
Sub RESET02()
'
' RESET02 Macro
'

'
    Sheets("COMPLETE").Select
    Columns("A:W").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("FBN CXL REQ").Select
    Columns("A:AK").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("TTI DATA").Select
    Columns("E:DC").Select
    Selection.Delete Shift:=xlToLeft
    Range("E1").Select
End Sub
 
Upvote 0
Ok, give this a try.
VBA Code: 
Sub FSOMoveAllFiles()
    Dim FSO As New FileSystemObject                   'early binding of FSO oject
    Dim FromPath As String, ToPath As String, FileInFromFolder As File, DateStr As String, FldrName As String, BasePath As String
    Dim DestFileName As String
    Dim MCnt As Long, Msg As String
    
    DateStr = Format(Now(), "M-DD-YYYY")
    FldrName = "FBN CXL REQ " & DateStr
    BasePath = "G:\Branches\VS-SpaceX\Benjamin\FABRINET_THF002\CANCELED POs\"
    FromPath = "H:\Desktop"
    If Right(Trim(BasePath), 1) <> "\" Then
        BasePath = Trim(BasePath) & "\"
    End If
    
    If Right(Trim(FromPath), 1) <> "\" Then
        FromPath = Trim(FromPath) & "\"
    End If
    
    If Not FSO.FolderExists(FromPath) Then
        MsgBox "Folder '" & FromPath & "' does not exist", vbCritical
        Exit Sub
    End If
    
    If Not FSO.FolderExists(BasePath) Then
        MsgBox "Folder '" & BasePath & "' does not exist", vbCritical
        Exit Sub
    End If
    
    ToPath = BasePath & FldrName
    If Right(Trim(ToPath), 1) <> "\" Then
        ToPath = Trim(ToPath) & "\"
    End If
    
    If Not FSO.FolderExists(ToPath) Then
        FSO.CreateFolder ToPath
    End If
    
    If Not FSO.FolderExists(ToPath) Then
        MsgBox "Folder '" & ToPath & "' does not exist" & vbCr & vbCr & "Folder creation unsuccessful", vbCritical    'optional
        Exit Sub
    End If
    
    With FSO.GetFolder(FromPath)
        For Each FileInFromFolder In .Files
            Select Case Trim(Left(FileInFromFolder.Name, 12))
                Case "CANCEL.xlsx", "THF002.xlsx", "FBN CXL REQ"
                    DestFileName = ToPath & FileInFromFolder.Name
                    If FSO.FileExists(DestFileName) Then
                        Select Case MsgBox("File '" & FileInFromFolder.Name & "' already exists in the destination folder. " & vbCrLf & vbCrLf _
                                & "Do you want to overwrite it?", vbYesNoCancel Or vbQuestion, Application.Name)
                            Case vbYes
                                Kill DestFileName
                                FileInFromFolder.Move ToPath
                                MCnt = MCnt + 1
                            Case vbCancel
                                Exit Sub
                        End Select
                    Else
                        ''' debug code begins here (remove after testing complete)
                        Msg = Msg & "File Name  = " & FileInFromFolder.Name & vbCr & vbCr
                        Msg = Msg & "DateStr  = " & DateStr & vbCr
                        Msg = Msg & "FldrName = " & FldrName & vbCr
                        Msg = Msg & "BasePath = " & BasePath & vbCr
                        Msg = Msg & "FromPath = " & FromPath & vbCr
                        Msg = Msg & "ToPath = " & ToPath & vbCr
                        Msg = Msg & "DestFileName = " & DestFileName & vbCr
                        Msg = Msg & "DestFileName Exists? = " & FSO.FileExists(DestFileName)
                        MsgBox Msg, , "Debug Info"
                        Msg = ""
                        ''' debug code ends here
                        
                        FileInFromFolder.Move ToPath
                        MCnt = MCnt + 1
                    End If
            End Select
        Next FileInFromFolder
    End With
    
    MsgBox MCnt & " files moved.", vbInformation
End Sub
 
Upvote 1
Solution
rlv01 said:
Ok, give this a try.
VBA Code: 
Sub FSOMoveAllFiles()
    Dim FSO As New FileSystemObject                   'early binding of FSO oject
    Dim FromPath As String, ToPath As String, FileInFromFolder As File, DateStr As String, FldrName As String, BasePath As String
    Dim DestFileName As String
    Dim MCnt As Long, Msg As String
  
    DateStr = Format(Now(), "M-DD-YYYY")
    FldrName = "FBN CXL REQ " & DateStr
    BasePath = "G:\Branches\VS-SpaceX\Benjamin\FABRINET_THF002\CANCELED POs\"
    FromPath = "H:\Desktop"
    If Right(Trim(BasePath), 1) <> "\" Then
        BasePath = Trim(BasePath) & "\"
    End If
  
    If Right(Trim(FromPath), 1) <> "\" Then
        FromPath = Trim(FromPath) & "\"
    End If
  
    If Not FSO.FolderExists(FromPath) Then
        MsgBox "Folder '" & FromPath & "' does not exist", vbCritical
        Exit Sub
    End If
  
    If Not FSO.FolderExists(BasePath) Then
        MsgBox "Folder '" & BasePath & "' does not exist", vbCritical
        Exit Sub
    End If
  
    ToPath = BasePath & FldrName
    If Right(Trim(ToPath), 1) <> "\" Then
        ToPath = Trim(ToPath) & "\"
    End If
  
    If Not FSO.FolderExists(ToPath) Then
        FSO.CreateFolder ToPath
    End If
  
    If Not FSO.FolderExists(ToPath) Then
        MsgBox "Folder '" & ToPath & "' does not exist" & vbCr & vbCr & "Folder creation unsuccessful", vbCritical    'optional
        Exit Sub
    End If
  
    With FSO.GetFolder(FromPath)
        For Each FileInFromFolder In .Files
            Select Case Trim(Left(FileInFromFolder.Name, 12))
                Case "CANCEL.xlsx", "THF002.xlsx", "FBN CXL REQ"
                    DestFileName = ToPath & FileInFromFolder.Name
                    If FSO.FileExists(DestFileName) Then
                        Select Case MsgBox("File '" & FileInFromFolder.Name & "' already exists in the destination folder. " & vbCrLf & vbCrLf _
                                & "Do you want to overwrite it?", vbYesNoCancel Or vbQuestion, Application.Name)
                            Case vbYes
                                Kill DestFileName
                                FileInFromFolder.Move ToPath
                                MCnt = MCnt + 1
                            Case vbCancel
                                Exit Sub
                        End Select
                    Else
                        ''' debug code begins here (remove after testing complete)
                        Msg = Msg & "File Name  = " & FileInFromFolder.Name & vbCr & vbCr
                        Msg = Msg & "DateStr  = " & DateStr & vbCr
                        Msg = Msg & "FldrName = " & FldrName & vbCr
                        Msg = Msg & "BasePath = " & BasePath & vbCr
                        Msg = Msg & "FromPath = " & FromPath & vbCr
                        Msg = Msg & "ToPath = " & ToPath & vbCr
                        Msg = Msg & "DestFileName = " & DestFileName & vbCr
                        Msg = Msg & "DestFileName Exists? = " & FSO.FileExists(DestFileName)
                        MsgBox Msg, , "Debug Info"
                        Msg = ""
                        ''' debug code ends here
                      
                        FileInFromFolder.Move ToPath
                        MCnt = MCnt + 1
                    End If
            End Select
        Next FileInFromFolder
    End With
  
    MsgBox MCnt & " files moved.", vbInformation
End Sub
Click to expand...
Just tried this with this weeks new data, but still getting the error same exact place. It is creating the new folder in the correct location, b ut its just not moving anything.

VBA Code: 
Sub FSOMoveAllFiles()
    Dim FSO As New FileSystemObject                   'early binding of FSO oject
    Dim FromPath As String, ToPath As String, FileInFromFolder As File, DateStr As String, FldrName As String, BasePath As String
    Dim DestFileName As String
    Dim MCnt As Long, Msg As String
   
    DateStr = Format(Now(), "M-DD-YYYY")
    FldrName = "FBN CXL REQ " & DateStr
    BasePath = "G:\Branches\VS-SpaceX\Benjamin\FABRINET_THF002\CANCELED POs\"
    FromPath = "H:\Desktop"
    If Right(Trim(BasePath), 1) <> "\" Then
        BasePath = Trim(BasePath) & "\"
    End If
   
    If Right(Trim(FromPath), 1) <> "\" Then
        FromPath = Trim(FromPath) & "\"
    End If
   
    If Not FSO.FolderExists(FromPath) Then
        MsgBox "Folder '" & FromPath & "' does not exist", vbCritical
        Exit Sub
    End If
   
    If Not FSO.FolderExists(BasePath) Then
        MsgBox "Folder '" & BasePath & "' does not exist", vbCritical
        Exit Sub
    End If
   
    ToPath = BasePath & FldrName
    If Right(Trim(ToPath), 1) <> "\" Then
        ToPath = Trim(ToPath) & "\"
    End If
   
    If Not FSO.FolderExists(ToPath) Then
        FSO.CreateFolder ToPath
    End If
   
    If Not FSO.FolderExists(ToPath) Then
        MsgBox "Folder '" & ToPath & "' does not exist" & vbCr & vbCr & "Folder creation unsuccessful", vbCritical    'optional
        Exit Sub
    End If
   
    With FSO.GetFolder(FromPath)
        For Each FileInFromFolder In .Files
            Select Case Trim(Left(FileInFromFolder.Name, 12))
                Case "CANCEL.xlsx", "THF002.xlsx", "FBN CXL REQ"
                    DestFileName = ToPath & FileInFromFolder.Name
                    If FSO.FileExists(DestFileName) Then
                        Select Case MsgBox("File '" & FileInFromFolder.Name & "' already exists in the destination folder. " & vbCrLf & vbCrLf _
                                & "Do you want to overwrite it?", vbYesNoCancel Or vbQuestion, Application.Name)
                            Case vbYes
                                Kill DestFileName
                                FileInFromFolder.Move ToPath
                                MCnt = MCnt + 1
                            Case vbCancel
                                Exit Sub
                        End Select
                    Else
                        ''' debug code begins here (remove after testing complete)
                        Msg = Msg & "File Name  = " & FileInFromFolder.Name & vbCr & vbCr
                        Msg = Msg & "DateStr  = " & DateStr & vbCr
                        Msg = Msg & "FldrName = " & FldrName & vbCr
                        Msg = Msg & "BasePath = " & BasePath & vbCr
                        Msg = Msg & "FromPath = " & FromPath & vbCr
                        Msg = Msg & "ToPath = " & ToPath & vbCr
                        Msg = Msg & "DestFileName = " & DestFileName & vbCr
                        Msg = Msg & "DestFileName Exists? = " & FSO.FileExists(DestFileName)
                        MsgBox Msg, , "Debug Info"
                        Msg = ""
                        ''' debug code ends here
                       
                        FileInFromFolder.Move ToPath
                        MCnt = MCnt + 1
                    End If
            End Select
        Next FileInFromFolder
    End With
   
    MsgBox MCnt & " files moved.", vbInformation
End Sub
1715615101654.png
 
Upvote 0
SantanaKRE8s said:
Just tried this with this weeks new data, but still getting the error same exact place. It is creating the new folder in the correct location, but its just not moving anything.
Click to expand...

A couple of things:
1. Debug information. Posting to say you tried it and it did not work is of limited value. I cannot help without information, and I don't understand why you are not including available debug information. What have you learned from the new debug information message box I added to the code, and why are you not sharing that information?

1715621697427.png


2. Error information. You should get into the habit of providing more error information. For any error (compile error or runtime error) you should report 3 things:
1. Error number​
2. Error message​
3. Line of code that generates the error.​
 
Upvote 0
rlv01 said:
A couple of things:
1. Debug information. Posting to say you tried it and it did not work is of limited value. I cannot help without information, and I don't understand why you are not including available debug information. What have you learned from the new debug information message box I added to the code, and why are you not sharing that information?

View attachment 111328

2. Error information. You should get into the habit of providing more error information. For any error (compile error or runtime error) you should report 3 things:
1. Error number​
2. Error message​
3. Line of code that generates the error.​
Click to expand...
Ok, so Im not sure why it did not work or give me the Debug info msg box the first time I ran the new code, but I tried it again and its working perfectly. thank you very much for your patience.
 
Upvote 0
SantanaKRE8s said:
Ok, so Im not sure why it did not work or give me the Debug info msg box the first time I ran the new code, but I tried it again and its working perfectly. thank you very much for your patience.
Click to expand...
It workedd perfect once, I deleted to folder it created and tried it again and it did not work. It gave me the first pop up msg for File Name = CANCEL, I clicked OK and the gave me " Run-time error '70': Permision denied.

1715632359674.png
1715632380507.png
1715632389463.png
 
Upvote 0
Runtime Error 70 is an indication that you do not have permission for the move operation in that folder. Any ideas why that might be the case? Reasons might include a permission problem with either source or destination, or an already open source file, or a source file locked by an application. You could try replacing FileInFromFolder.Move ToPath with FileInFromFolder.Move DestFileName , but I'm guessing that won't make a difference.
 
Upvote 1
rlv01 said:
Runtime Error 70 is an indication that you do not have permission for the move operation in that folder. Any ideas why that might be the case? Reasons might include a permission problem with either source or destination, or an already open source file, or a source file locked by an application. You could try replacing FileInFromFolder.Move ToPath with FileInFromFolder.Move DestFileName , but I'm guessing that won't make a difference.
Click to expand...
Hello @rlv01, sorry I did not get a chance to respond, but I wanted to thank you for your patience and help with this request. Its working great, I already marked the solution. the run time error was an error on my side, one of the files that was going to be moved was opened.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
VBA to Move files to another folder
Replies
3
Views
278
SantanaKRE8s
S
N
  • Solved
VB Script to Read Cells in Column A and Check if Folder Exists and if So Copy if not display message and move onto next cell
Replies
2
Views
786
NBoudreault
N
Jambi46n2
  • Question Question
Copying Multiple Paths/Files/Folders to New Paths and Rename with VBA
Replies
3
Views
2K
sijpie
sijpie
J
  • Solved
move files to folder
Replies
5
Views
1K
JAVEDR
J
C
  • Solved
VBA listing folders, sub-folders & file names - modification required
Replies
5
Views
1K
NdNoviceHlp
NdNoviceHlp

Forum statistics

Threads
1,224,817
Messages
6,181,149
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top