Excel Forum

Code: Select all

Sub LoopThroughDirectory()
 Worksheets("Collect Data").Range("A3:Z100000").ClearContents
 
 Dim MyFile As String
 Dim erow
 Dim Filepath As String
 Filepath = "D:\Test\"
  MyFile = Dir(Filepath)
 Do While Len(MyFile) > 0
     If MyFile = "TODAY PREM MATCHING_Master_V2 - Test.xlsm" Then
     Exit Sub
     End If
     
     Workbooks.Open (Filepath & MyFile)
     Sheets(1).Name = "Daily Premium matching"
     Sheets("Daily Premium matching").Select
     Range("A2", ActiveCell.SpecialCells(xlLastCell)).Select
     Selection.Copy
     
     
     Windows("TODAY PREM MATCHING_Master_V2 - Test.xlsm").Activate
     erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
     ActiveSheet.Paste Destination:=Worksheets("Collect Data").Range(Cells(erow, 1), Cells(erow, 26))
     Windows(MyFile).Activate
     
     Application.DisplayAlerts = False
     ActiveWindow.Close
   
     MyFile = Dir
     'ThisWorkbook.Worksheets("sheet1").Cells.EntireColumn.AutoFit
    
     Cells.Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
    End With
 Loop
 
 'ActiveSheet.Columns("BO").NumberFormat = "General"
 End Sub

Code: Select all

Sub CollectBroker()
Sheets("Broker").Activate
Range("A2").Select

Application.CommandBars("Office Clipboard").Visible = False

'Application.Goto Reference:="Broker_Collect"

'Range(Range("A2"), Range("A2").End(xlDown)).Select
'Range(Range("A2"), Range("A2").End(xlToRight)).Select
'Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
'Application.CutCopyMode = False
    
Selection.Copy

Sheets("AllCollect-Broker").Select
    Range("A2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    
Sheets("Broker").Select
Range("A2").Select
Application.CutCopyMode = False
    
End Sub

Code: Select all

'Other code
Selection.Copy
     
     Windows("TODAY PREM MATCHING_Master_V2 - Test.xlsm").Activate
     erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
     Worksheets("Collect Data").Activate
     ActiveSheet.Paste Destination:=Worksheets("Collect Data").Range(Cells(erow, 1), Cells(erow, 26))
     Application.CutCopyMode = False
     Windows(MyFile).Activate
     
     Application.DisplayAlerts = False
     'Other code

Code: Select all

Sub CollectBroker()
    Dim lstRw As Long
    Dim sc As Range
    Application.CommandBars("Office Clipboard").Visible = False
    
    With Sheets("Broker")
        If .Range("a2").Value = "" Then
            lstRw = 2
        Else
            lstRw = .Range("a" & .Rows.Count).End(xlUp).Row
        End If
        Set sc = .Range("a2:q" & lstRw)
    End With
    With Sheets("AllCollect-Broker")
        sc.Copy .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0)
    End With
    Sheets("Broker").Select
    Range("A2").Select
    Application.CutCopyMode = False
End Sub