Loop through sheets to paste date values in dd/mm/yy format into a master sheet

Question

I have code to loop through several sheets of data.

Dim MyFile As String
Dim erow
MyFile = Dir("C:\My Documents\Tester")

Workbooks.Open ("C:\My Docments\Tester\TestLog.xlsm")

Sheets("Master").Select
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Application.DisplayAlerts = False

Do While Len(MyFile) > 0
  If MyFile = "ZMaster - Call Log.xlsm" Then
    Exit Sub
  End If

  Workbooks.Open (MyFile)
  Application.DisplayAlerts = False
  Sheets("Calls").Activate
  Range("A2:P2").Select
  Range(Selection, Selection.End(xlDown)).Select
  Selection.Copy

  ActiveWindow.Close savechanges:=False

  erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
  ActiveSheet.Paste Destination:=Worksheets("Master").Range(Cells(erow, 1), Cells(erow, 16))

I have two issues.

Firstly the macro fails unless the first workbook in the loop was "Saved As" by myself. Not Saved only Saved As. If I open the first workbook, click save as under the same file name then run the macro it works. I have developed a work around by the macro opening the first workbook and saving as.

Second and most importantly. My sub workbooks all have the date in English format. However when pasting to the Zmaster it is coming across as 12/01/16 rather than 01/12/16.

Just to clarify my date issue in my sub workbooks the date format is =NOW which is DD/MM/YY HH/MM/SS however when pasting this across into the master sheet which was working fine for 10 days on the first of December it is pasting MM/DD/YY — MBrann
Since you are dealing with multiple workbooks, removing activate and select/selection from your code and qualifying everything will make things easier to debug and follow. stackoverflow.com/questions/10714251/… — Rdster

Doug Coats Doug Coats · Accepted Answer · 2016-12-01T15:31:56

I added my "sift through multiple files in a folder" script i use over and over again.

Also instead of copy pasting see how a move data around

 Sub Theloopofloops()

 Dim wbk As Workbook
 Dim Filename As String
 Dim path As String
 Dim rCell As Range
 Dim rRng As Range
 Dim wsO As Worksheet
 Dim sheet As Worksheet


 path = "pathtofile(s)" & "\"
 Filename = Dir(path & "*.xl??")
 Set wsO = ThisWorkbook.Sheets("Sheet1") 'included in case you need to differentiate_
              between workbooks i.e currently opened workbook vs workbook containing code

 Do While Len(Filename) > 0
     DoEvents
     Set wbk = Workbooks.Open(path & Filename, True, True)
         For Each sheet In ActiveWorkbook.Worksheets  'this needs to be adjusted for specifiying sheets. Repeat loop for each sheet so thats on a per sheet basis
                Set rRng = sheet.Range("a1:a1000") 'OBV needs to be changed
                For Each rCell In rRng.Cells
                If rCell <> "" And rCell.Value <> vbNullString And rCell.Value <> 0 Then

                   'code that does stuff
                    wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(1, 0).Value = rCell
                    wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(0, 1).Value = rCell.Offset(0, -1)
                    wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(0, 2).Value = Mid(Right(ActiveWorkbook.FullName, 15), 1, 10)

                End If
                Next rCell
         Next sheet
     wbk.Close False
     Filename = Dir
 Loop
 End Sub

Loop through sheets to paste date values in dd/mm/yy format into a master sheet

1 Answers