Copy pasting specific data from multiple sheets

[MacroBegin]

Hi All experts
I am a beginner in VBA trying to build some basic macros in my organisation.

Basically, I need to copy a particular cell value (from the same tab-sheet1, same cell-G37) from 30 different files (1 for each day in a month) into one masterfile with just 1 tab (sheet3) in 30 different columns with dates in Row2 and values (from Sheet1-cell G37 of source files for each day) to be pasted correspondingly in Row3. So it will be a table of 2 rows and 30 columns with date in Row2 and values in Row3.

The common link between the source and destination file will be the date. In Source File- It would be mentioned each day in Sheet1 tab Cell F2 and in Masterfile across the columns from B2,C2,D2,E2,etc...

All the source files will have same name with the exception of date at the end and would be placed in one common folder.

Please help me create a VBA for this in a separate file (separate from the source or destination files)

Thanks so much in advance. Would appreciate a quick help on this. I might have missed out few details since I am new, please let me know if you need more info

 

[Zot]

My imagination is running wild here ?

This is what I imagined:
You have Data files in a specific folder. There are 30 files which each one represents data for each day.
You need to collect data located at fixed location in Sheet1 G37.
Data need to written into a Master File Sheet3 from B2, C2, D2, until finish 30 days (or perhaps 31 days?)
Each source file in folder has Date(?) value in Sheet1 F2.

Is this correct?

 

[MacroBegin]

My imagination is running wild here ?

This is what I imagined:
You have Data files in a specific folder. There are 30 files which each one represents data for each day.
You need to collect data located at fixed location in Sheet1 G37.
Data need to written into a Master File Sheet3 from B2, C2, D2, until finish 30 days (or perhaps 31 days?)
Each source file in folder has Date(?) value in Sheet1 F2.

Is this correct?

Hey Zot... This is absolutely correct. each of the 30/31 files for a month have the corresponding date in Sheet1 F2 cell. Not sure if its relevant though I still wanted to give it out.
Also many thanks for replying. Hoping you can help me here.

 

[Zot]

Workbook Master has dates in Sheet3 starting from A1, B1, C1, all across the column until 30th or 31st according to month
Data workbooks is located is a folder (C:\Test2 in my example here) with date in F2 (cell is formatted as Date) and data of interest in G37

The macro below is to be copied in regular Module. The program will match the date in from source file with proper date column in Master workbook. It will fill data to next empty row in Master workbook, searching from bottom up. It will fill row 2, 3, 4, 5 and so on (I'm not sure if you just want to fill only row 2 or not on Master workbook). So, if there is any occupied cell from bottom up before row 2 then the data will be written in inappropriate row.

If you want to only fill in row 2, then change
wsMaster.Cells(Rows.Count, colDate).End(xlUp).Offset(1) = ws.Range("G37")
to
wsMaster.Cells(2, colDate) = ws.Range("G37")

Sub GetDailyData()

Dim colDate As Long
Dim FPath As String, strDate As String
Dim wsDate As Date
Dim FName As Variant
Dim FoundDate As Range, rngDate As Range
Dim wsMaster As Worksheet, ws As Worksheet
Dim wbMaster As Workbook, wb As Workbook

Application.ScreenUpdating = False

Set wbMaster = ActiveWorkbook
Set wsMaster = wbMaster.Sheets("Sheet3")
Set rngDate = wsMaster.Range("A1", wsMaster.Cells(1, Columns.Count).End(xlToLeft))

FPath = "C:\Test2\"        ' Set your folder path here
If Not Right(FPath, 1) = "\" Then FPath = FPath & "\"
FName = Dir(FPath)

While FName <> ""
    Set wb = Workbooks.Open(Filename:=FPath & FName, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    Set ws = wb.Sheets("Sheet1")
    strDate = ws.Range("F2").Value2
    wsDate = CDate(strDate)
    Set FoundDate = rngDate.Find(wsDate)
    If Not FoundDate Is Nothing Then
        colDate = FoundDate.Column
        wsMaster.Cells(Rows.Count, colDate).End(xlUp).Offset(1) = ws.Range("G37")
    End If
    'Close wb without saving
    wb.Close False
    'Set the fileName to the next file
    FName = Dir
Wend

End Sub

 

[MacroBegin]

Workbook Master has dates in Sheet3 starting from A1, B1, C1, all across the column until 30th or 31st according to month
Data workbooks is located is a folder (C:\Test2 in my example here) with date in F2 (cell is formatted as Date) and data of interest in G37

The macro below is to be copied in regular Module. The program will match the date in from source file with proper date column in Master workbook. It will fill data to next empty row in Master workbook, searching from bottom up. It will fill row 2, 3, 4, 5 and so on (I'm not sure if you just want to fill only row 2 or not on Master workbook). So, if there is any occupied cell from bottom up before row 2 then the data will be written in inappropriate row.

If you want to only fill in row 2, then change
wsMaster.Cells(Rows.Count, colDate).End(xlUp).Offset(1) = ws.Range("G37")
to
wsMaster.Cells(2, colDate) = ws.Range("G37")

Sub GetDailyData()

Dim colDate As Long
Dim FPath As String, strDate As String
Dim wsDate As Date
Dim FName As Variant
Dim FoundDate As Range, rngDate As Range
Dim wsMaster As Worksheet, ws As Worksheet
Dim wbMaster As Workbook, wb As Workbook

Application.ScreenUpdating = False

Set wbMaster = ActiveWorkbook
Set wsMaster = wbMaster.Sheets("Sheet3")
Set rngDate = wsMaster.Range("A1", wsMaster.Cells(1, Columns.Count).End(xlToLeft))

FPath = "C:\Test2\"        ' Set your folder path here
If Not Right(FPath, 1) = "\" Then FPath = FPath & "\"
FName = Dir(FPath)

While FName <> ""
    Set wb = Workbooks.Open(Filename:=FPath & FName, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    Set ws = wb.Sheets("Sheet1")
    strDate = ws.Range("F2").Value2
    wsDate = CDate(strDate)
    Set FoundDate = rngDate.Find(wsDate)
    If Not FoundDate Is Nothing Then
        colDate = FoundDate.Column
        wsMaster.Cells(Rows.Count, colDate).End(xlUp).Offset(1) = ws.Range("G37")
    End If
    'Close wb without saving
    wb.Close False
    'Set the fileName to the next file
    FName = Dir
Wend

End Sub

Thanks Zot, will try tonight and update you tomorrow. Much appreciated

 

[MacroBegin]

Workbook Master has dates in Sheet3 starting from A1, B1, C1, all across the column until 30th or 31st according to month
Data workbooks is located is a folder (C:\Test2 in my example here) with date in F2 (cell is formatted as Date) and data of interest in G37

The macro below is to be copied in regular Module. The program will match the date in from source file with proper date column in Master workbook. It will fill data to next empty row in Master workbook, searching from bottom up. It will fill row 2, 3, 4, 5 and so on (I'm not sure if you just want to fill only row 2 or not on Master workbook). So, if there is any occupied cell from bottom up before row 2 then the data will be written in inappropriate row.

If you want to only fill in row 2, then change
wsMaster.Cells(Rows.Count, colDate).End(xlUp).Offset(1) = ws.Range("G37")
to
wsMaster.Cells(2, colDate) = ws.Range("G37")

Sub GetDailyData()

Dim colDate As Long
Dim FPath As String, strDate As String
Dim wsDate As Date
Dim FName As Variant
Dim FoundDate As Range, rngDate As Range
Dim wsMaster As Worksheet, ws As Worksheet
Dim wbMaster As Workbook, wb As Workbook

Application.ScreenUpdating = False

Set wbMaster = ActiveWorkbook
Set wsMaster = wbMaster.Sheets("Sheet3")
Set rngDate = wsMaster.Range("A1", wsMaster.Cells(1, Columns.Count).End(xlToLeft))

FPath = "C:\Test2\"        ' Set your folder path here
If Not Right(FPath, 1) = "\" Then FPath = FPath & "\"
FName = Dir(FPath)

While FName <> ""
    Set wb = Workbooks.Open(Filename:=FPath & FName, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    Set ws = wb.Sheets("Sheet1")
    strDate = ws.Range("F2").Value2
    wsDate = CDate(strDate)
    Set FoundDate = rngDate.Find(wsDate)
    If Not FoundDate Is Nothing Then
        colDate = FoundDate.Column
        wsMaster.Cells(Rows.Count, colDate).End(xlUp).Offset(1) = ws.Range("G37")
    End If
    'Close wb without saving
    wb.Close False
    'Set the fileName to the next file
    FName = Dir
Wend

End Sub

Hey Zot

Unfortunately It did not work. I did copy in the module and ran the macro but nothing happened it seems. Quick few things I wanted to highlight
1) I need the data in master file across rows not columns, I saw your note and changed the code to copy in rows instead but did not work
2) The source file has data in cells IN e1 (date) and G36 (data of interest) - sorry my bad but I did change it in the code you gave me but did not seem to work
3) All the source files are xls files not xlsx - would that be causing any issue?
4) I Have given screenshots for both source and destination worksheet to give you a feel of how the data looks in those respective tabs with exact placement of destination data (yellow highlighted row)
5) in the last section of the code its mentioned 'Set the fileName to the next file - Do I need to do something here? I gave the the folder path of the source files in the code where you have mentioned though.

See if you need to change the code please? I am sorry for this to be taking you this much time- may be because I am a complete beginner.

 

[Zot]

My program copy data from source to paste to B2, C2, D2, and so on. It was correct.

I notice that your sheet name is not Sheet3 or Sheet1. The code should work. I have created mock up files and tested it.

Sub GetDailyData()

Dim colDate As Long
Dim FPath As String, strDate As String
Dim wsDate As Date
Dim FName As Variant
Dim FoundDate As Range, rngDate As Range
Dim wsMaster As Worksheet, ws As Worksheet
Dim wbMaster As Workbook, wb As Workbook

Application.ScreenUpdating = False

Set wbMaster = ActiveWorkbook
Set wsMaster = wbMaster.Sheets("Destination Master formatSheet3")      ' Change the sheet name for destination master here
Set rngDate = wsMaster.Range("A1", wsMaster.Cells(1, Columns.Count).End(xlToLeft))

FPath = "C:\Test2\"       ' Set your folder path here
If Not Right(FPath, 1) = "\" Then FPath = FPath & "\"
FName = Dir(FPath)

While FName <> ""
    Set wb = Workbooks.Open(Filename:=FPath & FName, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    Set ws = wb.Sheets("Source FormatSheet1")       ' Change the sheet name for source file here
    strDate = ws.Range("E1").Value2
    wsDate = CDate(strDate)
    Set FoundDate = rngDate.Find(wsDate)
    If Not FoundDate Is Nothing Then
        colDate = FoundDate.Column
        wsMaster.Cells(Rows.Count, colDate).End(xlUp).Offset(1) = ws.Range("G36")
    End If
    'Close wb without saving
    wb.Close False
    'Set the fileName to the next file
    FName = Dir
Wend

End Sub

 

[MacroBegin]

a

My program copy data from source to paste to B2, C2, D2, and so on. It was correct.

I notice that your sheet name is not Sheet3 or Sheet1. The code should work. I have created mock up files and tested it.

Sub GetDailyData()

Dim colDate As Long
Dim FPath As String, strDate As String
Dim wsDate As Date
Dim FName As Variant
Dim FoundDate As Range, rngDate As Range
Dim wsMaster As Worksheet, ws As Worksheet
Dim wbMaster As Workbook, wb As Workbook

Application.ScreenUpdating = False

Set wbMaster = ActiveWorkbook
Set wsMaster = wbMaster.Sheets("Destination Master formatSheet3")      ' Change the sheet name for destination master here
Set rngDate = wsMaster.Range("A1", wsMaster.Cells(1, Columns.Count).End(xlToLeft))

FPath = "C:\Test2\"       ' Set your folder path here
If Not Right(FPath, 1) = "\" Then FPath = FPath & "\"
FName = Dir(FPath)

While FName <> ""
    Set wb = Workbooks.Open(Filename:=FPath & FName, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    Set ws = wb.Sheets("Source FormatSheet1")       ' Change the sheet name for source file here
    strDate = ws.Range("E1").Value2
    wsDate = CDate(strDate)
    Set FoundDate = rngDate.Find(wsDate)
    If Not FoundDate Is Nothing Then
        colDate = FoundDate.Column
        wsMaster.Cells(Rows.Count, colDate).End(xlUp).Offset(1) = ws.Range("G36")
    End If
    'Close wb without saving
    wb.Close False
    'Set the fileName to the next file
    FName = Dir
Wend

End Sub

Thanks Zot, the tab names in the screenshot I shared were only examples and actual sheet names are Sheet 1 and Sheet 3 only that I previously shared.
Also, the earlier macro code you shared was fine and I realised it did not work because the date formats in both the files are not the same.
In the source files, the date format is different than the destination master file. In the source files, the date is ending with timestamp whereas the destination file has DD-MMM-YY format in Row1 across columns. Is there a way that before doing anything else the code opens each source file in the folder and changes the date format in all source files Sheet1 cell E1 to DD-MMM-YY and then follows all the above mentioned steps? Without this to happen I am not sure how we can achieve this. Sorry it might be a second requirement but appreciate your patience and help buddy!

 

[Zot]

Actually I do not need to use CDate because the source date is already in Date format and stored as Date value already. The date in Excel is the Integer part of the number and numbers after decimal point (or fraction of it) is actually time. I just need to use Int command to strip off the decimal part and get just the date portion. Here's the code that should work for both (date with and without time portion)

Sub GetDailyData()

Dim colDate As Long
Dim FPath As String
Dim wsDate As Date
Dim Fname As Variant
Dim FoundDate As Range, rngDate As Range
Dim wsMaster As Worksheet, ws As Worksheet
Dim wbMaster As Workbook, wb As Workbook

Application.ScreenUpdating = False

Set wbMaster = ActiveWorkbook
Set wsMaster = wbMaster.Sheets("Sheet3")      ' Change the sheet name for destination master here
Set rngDate = wsMaster.Range("A1", wsMaster.Cells(1, Columns.Count).End(xlToLeft))

FPath = "C:\Test2\"        ' Set your folder path here
If Not Right(FPath, 1) = "\" Then FPath = FPath & "\"
Fname = Dir(FPath)

While Fname <> ""
    Set wb = Workbooks.Open(Filename:=FPath & Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    Set ws = wb.Sheets("Sheet1")                                       ' Change the sheet name for source file here
    wsDate = Int(ws.Range("E1").Value2)
    Set FoundDate = rngDate.Find(wsDate)
    If Not FoundDate Is Nothing Then
        colDate = FoundDate.Column
        wsMaster.Cells(Rows.Count, colDate).End(xlUp).Offset(1) = ws.Range("G36")
    End If
    'Close wb without saving
    wb.Close False
    'Set the fileName to the next file
    Fname = Dir
Wend

End Sub