0
votes

I got this code through the website source. https://www.xelplus.com/excel-vba-getopenfilename/

From this I create VBA code by daily which is insert data day by day (data by daily).

But now I need select all Excel in one folder or mutli-select and generate it (data by monthly). - objective

Here is Description:

Excel (TOT Process) v2

  • Sheet "Control" as place for generate report
  • Sheet "Bank 1" as data summaries and link by formula at Sheet Data Coll A
  • Sheet "Data Coll A" as all data collect

Folder Source Data - Excel 1,2,3...

  • Sheet "Detail Report & User" as details user

  • Sheet "NAT Cash Float" as data need collect

Here Sample VBA Code (date 1)

'DATE 1     
Sub Generate_Type1_Date1()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy 'Range Copy
        ThisWorkbook.Worksheets("Data Coll A").Range("C1").PasteSpecial xlPasteValues 'Range Paste
        OpenBook.Close False
        
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Sheets("Control").Select
End Sub     

Here VBA code that I change by date

'Date 1
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("C1").PasteSpecial xlPasteValues

'Date 2  
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("AD1").PasteSpecial xlPasteValues

'Date 3
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("BE1").PasteSpecial xlPasteValues

'Date 4
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("CF1").PasteSpecial xlPasteValues

'Date 5
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("DG1").PasteSpecial xlPasteValues

'Date 6
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("EH1").PasteSpecial xlPasteValues

'Date 7
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("FI1").PasteSpecial xlPasteValues

'Date 8
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("GI1").PasteSpecial xlPasteValues

'Date 9
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("HK1").PasteSpecial xlPasteValues

'Date 10
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("IL1").PasteSpecial xlPasteValues

'Date 11
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("JM1").PasteSpecial xlPasteValues

'Date 12
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("KN1").PasteSpecial xlPasteValues

'Date 13
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("LO1").PasteSpecial xlPasteValues

'Date 14
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("MP1").PasteSpecial xlPasteValues

'Date 15
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("NQ1").PasteSpecial xlPasteValues

'Date 16
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("OR1").PasteSpecial xlPasteValues

'Date 17
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("PS1").PasteSpecial xlPasteValues

'Date 18
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("QT1").PasteSpecial xlPasteValues

'Date 19
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("RU1").PasteSpecial xlPasteValues

'Date 20
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("SV1").PasteSpecial xlPasteValues

'Date 21
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("TW1").PasteSpecial xlPasteValues

'Date 22
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("UX1").PasteSpecial xlPasteValues

'Date 23
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("VY1").PasteSpecial xlPasteValues

'Date 24
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("WZ1").PasteSpecial xlPasteValues

'Date 25
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("YA1").PasteSpecial xlPasteValues

'Date 26
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("ZB1").PasteSpecial xlPasteValues

'Date 27
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("AAC1").PasteSpecial xlPasteValues

'Date 28
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("ABD1").PasteSpecial xlPasteValues

'Date 29
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("ACE1").PasteSpecial xlPasteValues

'Date 30
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("ADF1").PasteSpecial xlPasteValues

'Date 31
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("AEG1").PasteSpecial xlPasteValues

Here Sample Template in Google Drive:

HERE

I really appreciate your help. TQ

sorry for my bad eng.

2

2 Answers

0
votes

Is this what you’re looking for?

   'DATE 1     
    Sub Generate_Type1_Date1()
        Dim FileToOpen As Variant
        Dim OpenBook As Workbook
        Dim PasteTo As Integer
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        PasteTo = 3
        FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*", MultiSelect:=True)
        On Error Goto exitSub
            For Each item in FileToOpen
                Set OpenBook = Application.Workbooks.Open(item)
                OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy 'Range Copy
                ThisWorkbook.Worksheets("Data Coll A").Cells(1, PasteTo).PasteSpecial xlPasteValues 'Range Paste
                OpenBook.Close False
                PasteTo = PasteTo + 25
            Next
            
        On Error Goto 0
    exitSub:
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Sheets("Control").Select
    End Sub     
0
votes

after test afew time and check.. your code work success with some edit..

Thanks a lot

Here code I edit

    Sub Test_allFile()
        Dim FileToOpen As Variant
        Dim OpenBook As Workbook
        Dim PasteTo As Integer
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        PasteTo = 3
        FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*", MultiSelect:=True)
        On Error GoTo exitSub
            For Each Item In FileToOpen
                Set OpenBook = Application.Workbooks.Open(Item)
                OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy 'Range Copy
                ThisWorkbook.Worksheets("Data Coll A").Cells(1, PasteTo).PasteSpecial xlPasteValues 'Range Paste
                OpenBook.Close False
                PasteTo = PasteTo + 27
            Next
            
        On Error GoTo 0
exitSub:
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
    End Sub