macro help

[superfb]

Hi,

I was hoping to create a a macro that would be able to open multiple spreadsheets and copy date in order to create a master spreadsheet.

The following is a setup of the folders and spreadsheets and tabs:

1) I have data going from 1997 to 2021.​

2) Each year has 20 tables folder.​

3) Each 20 tables folders have almost 25 spreadsheets with almost 9 tabs.​

4) In those tabs can I specify what columns needs to be copied in the master spreadsheet​

If I specify the file locations that I require data from multiple years and the file names.

Could a macro extract this data and label the year in a time series?

Would appreciate thoughts or ideas.

Please let me know if you require further infi

 

[Logit]

Google "vba Copy all sheets to master"

 

[superfb]

Google "vba Copy all sheets to master"

Thank you. I did have a look but couldn't see anything that could meet the requirements.

I was thinking to have a list of dates in a column, next to it the the file location. So the macro could pick up the files.

As the files have 9 tabs. Sometimes only one is required. I'm not sure how to incorporate this.

 

[superfb]

I have googled multiple codes but i am unable to find anything

 

[superfb]

The below code can work but with some further adjustments

1) Rather than copying data and pasting it where the data ends for rows - it would be useful for me to count it by columns.
2) wkbSource.Sheets("CV notes").UsedRange.Copy - this code will only copy one tab, could i change this if i have another tab in the master spreadsheet and specify in a cell what tab i may require?
3) As the data is time series, if i have another tab specifying what tabs i require could i specify the dates so when the data is copied over i have the date heading?

i hope this makes sense.

Sub CopySheet()
 Application.ScreenUpdating = False
 Dim flder As FileDialog
 Dim FileName As String
 Dim FileChosen As Integer
 Dim wkbSource As Workbook
 Dim wkbDest As Workbook
 Set wkbDest = ThisWorkbook
OpenFile:
 Set flder = Application.FileDialog(msoFileDialogFilePicker)
 flder.Title = "Please Select an Excel File"
 flder.InitialFileName = "c:\"
 flder.InitialView = msoFileDialogViewSmallIcons
 flder.Filters.Clear
 flder.Filters.Add "Excel Files", "*.xls*"
 MsgBox ("Select a folder and then a file to open.")
 FileChosen = flder.Show
 FileName = flder.SelectedItems(1)
 Set wkbSource = Workbooks.Open(FileName)
wkbSource.Sheets("CV notes").UsedRange.Copy
 wkbDest.Sheets("Master").Cells(wkbDest.Sheets("Master").Column.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Application.CutCopyMode = False
 Application.ScreenUpdating = True
 wkbSource.Close savechanges:=False
 If MsgBox("Do you want to open another workbook?", vbYesNo) = vbYes Then GoTo OpenFile
End Sub

 

[superfb]

I think ideally i would like to have a sheet where i specify multiple file locations and file names, what tab i require the info and maybe specify the columns?

 

[superfb]

Ok seems like im gettting somewhere, but im getting an error particularly for lastCol = .Cells(.Columns.Count, Row).End(xlLeft).col

Also i do not want to past special values - how can i correct this?

Public strFileName As String
Public currentWB As Workbook
Public dataWB As Workbook
Public strCopyRange As String

Sub GetData()
    Dim strWhereToCopy As String
    Dim strStartCellColName As String
    Dim strListSheet As String
    
    strListSheet = "List"
    
    'On Error GoTo ErrH
    Sheets(strListSheet).Select
    Range("B2").Select
    
    'this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
    Set currentWB = ActiveWorkbook
    Do While ActiveCell.Value <> ""
        
        strFileName = ActiveCell.Offset(0, 1) '& ActiveCell.Value ' think it adds filpath then filename - can swap i think
        
        strWhereToCopy = currentWB.Sheets(Array("All", "Male", "Female", "Full-Time", "Part-Time", "Male Full-Time", _
        "Male Part-Time", "Female Full-Time", "Female Part-Time")).Select
      
        'ActiveCell.Offset(0, 4).Value 'tab
        
      
        'strCopyRange = ActiveCell.Offset(0, 2) & ":" & ActiveCell.Offset(0, 3) 'starts at b2 - links to col d and e
        'strStartCellColName = Mid(ActiveCell.Offset(0, 5), 2, 1)
        
        Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
        
        Set dataWB = ActiveWorkbook
        strCopyRange = Sheets(Array("All", "Male", "Female", "Full-Time", "Part-Time", "Male Full-Time", _
        "Male Part-Time", "Female Full-Time", "Female Part-Time")).Select
        Columns("A:G").Select
        Selection.Copy
        
        'Range(strCopyRange).Select
        'Selection.Copy
        
          Windows("vba-macro-to-copy-data-from-multiple-files2.xlsm").Activate
        'Sheets(strWhereToCopy).Select
        strWhereToCopy = currentWB.Sheets(Array("All", "Male", "Female", "Full-Time", "Part-Time", "Male Full-Time", _
        "Male Part-Time", "Female Full-Time", "Female Part-Time")).Select
        lastCol = LastColInOneRow(strStartCellColName)
        Cells(lastCol + 1, 1).Select
        
        Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        Application.CutCopyMode = False
        dataWB.Close False
        Sheets(strListSheet).Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Exit Sub
    
'ErrH:
    'MsgBox "It seems some file was missing. The data copy operation is not complete."
    'Exit Sub
End Sub

Public Function LastColInOneRow(col)
    'Find the last used row in a Column: column A in this example
 
    Dim lastCol As Long
    With ActiveSheet
    lastCol = .Cells(.Columns.Count, Row).End(xlLeft).col
    End With
    LastColInOneRow = lastCol
End Function

 

[superfb]

sorry guys, ive changed the formula to find the last column to copy the new data over

   LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Colum

so it starts on row 5 and goes to the right, but i still receive an error