VBA Macro copy cells or range in different workbooks same worksheet name to a single master workbook with date in every row

[rozek]

Hi. I'm new to this Forum. Any help is much appreciated. The objective as per the snapshot where I need to copy & paste only for colored cells. I guess the only difference from the other posts is how to add the dates repeatedly in the Mastersheet. Need some sort of looping I guess. Appreciate any help. Thank you

 

[rozek]

Another question, Are the closed workbooks all in the same folder or will each closed folder path need to be asked from the user?

In other words, do you know the path to the closed files or do you have to ask the user for each closed file?

In more other words, what is the path that the closed files are in, if you know it.

Hi johnny - Each closed folder path to be define by user. Thank you

 

[johnnyL]

Ok, I should have enough info from you now, I will try to whip some code up for you tomorrow night, if no one else does in the meantime.

 

[johnnyL]

@rozek Try the following code to see if it does what you asked for:

Sub rozek_MasterSheet_UpdaterV1()
'
    Dim DataRowCounter                          As Long
    Dim DestinationWorkbookSheetToCopyToRow     As Long
    Dim LastRowDestinationWorkbookSheetToCopyTo As Long
    Dim MaxNumberOfDataFilesToBeUsed            As Long
    Dim SourceFileNumber                        As Long
    Dim DataDate                                As String
    Dim SourceWorkbookSheetName                 As String
    Dim UserSelectedDataFileToOpen              As String
    Dim SourceWorkbook                          As Workbook
    Dim DestinationWorkbookSheetToCopyTo        As Worksheet
    Dim SourceWorkbookSheetToCopyFrom           As Worksheet
'
    MaxNumberOfDataFilesToBeUsed = 3                                                ' <--- Set this to the # of data files that you want to get data from
    SourceWorkbookSheetName = "Sheet1"                                              ' <--- Set this to the sheet name to copy data from
    Set DestinationWorkbookSheetToCopyTo = ThisWorkbook.Worksheets("MasterSheet")   ' <--- Set this to the sheet name to copy data to
'
    With DestinationWorkbookSheetToCopyTo.Range("A1:D1")                            ' Insert and Bold the Header for Destination Sheet
        .Value = Array("DATE", "NAME", "PRESS", "TEMP")
        .Font.Bold = True
    End With
'
    For SourceFileNumber = 1 To MaxNumberOfDataFilesToBeUsed                        ' Get data file paths/names Loop
        UserSelectedDataFileToOpen = Application.GetOpenFilename(Title:="Select File #" & SourceFileNumber & " of " & MaxNumberOfDataFilesToBeUsed & " files to Import Data from", FileFilter:="Excel Files (*.xls*), *xls*")
'
        If UserSelectedDataFileToOpen = "False" Then Exit Sub                                               ' Check to see if user clicked 'Cancel' or the 'X' button
'
                       Set SourceWorkbook = Workbooks.Open(UserSelectedDataFileToOpen)                      '   Open the selected data workbook
        Set SourceWorkbookSheetToCopyFrom = SourceWorkbook.Worksheets(SourceWorkbookSheetName)              '   Set the source workbook sheet name to copy data from
'
        LastRowDestinationWorkbookSheetToCopyTo = DestinationWorkbookSheetToCopyTo.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
           LastRowSourceWorkbookSheetToCopyFrom = SourceWorkbookSheetToCopyFrom.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
'
        DataDate = SourceWorkbookSheetToCopyFrom.Range("B1").Text                                               ' Grab the date from the data file worksheet

        For DataRowCounter = 3 To LastRowSourceWorkbookSheetToCopyFrom                                          ' Loop through the rows of data to copy from
            DestinationWorkbookSheetToCopyToRow = LastRowDestinationWorkbookSheetToCopyTo + DataRowCounter - 2  ' Set the row number to copy data to
'
            DestinationWorkbookSheetToCopyTo.Range("A" & DestinationWorkbookSheetToCopyToRow) = DataDate
            DestinationWorkbookSheetToCopyTo.Range("B" & DestinationWorkbookSheetToCopyToRow) = SourceWorkbookSheetToCopyFrom.Range("A" & DataRowCounter)
            DestinationWorkbookSheetToCopyTo.Range("C" & DestinationWorkbookSheetToCopyToRow) = SourceWorkbookSheetToCopyFrom.Range("C" & DataRowCounter)
            DestinationWorkbookSheetToCopyTo.Range("D" & DestinationWorkbookSheetToCopyToRow) = SourceWorkbookSheetToCopyFrom.Range("D" & DataRowCounter)
        Next
'
        SourceWorkbook.Close savechanges:=False                                                                 ' Close the data workbook without saving changes
    Next
'
    LastRowDestinationWorkbookSheetToCopyTo = DestinationWorkbookSheetToCopyTo.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
'
    With DestinationWorkbookSheetToCopyTo.Range("A1:D" & LastRowDestinationWorkbookSheetToCopyTo)               ' Center all the data in the Destination sheet
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
End Sub

 

[rozek]

@rozek Try the following code to see if it does what you asked for:

Sub rozek_MasterSheet_UpdaterV1()
'
    Dim DataRowCounter                          As Long
    Dim DestinationWorkbookSheetToCopyToRow     As Long
    Dim LastRowDestinationWorkbookSheetToCopyTo As Long
    Dim MaxNumberOfDataFilesToBeUsed            As Long
    Dim SourceFileNumber                        As Long
    Dim DataDate                                As String
    Dim SourceWorkbookSheetName                 As String
    Dim UserSelectedDataFileToOpen              As String
    Dim SourceWorkbook                          As Workbook
    Dim DestinationWorkbookSheetToCopyTo        As Worksheet
    Dim SourceWorkbookSheetToCopyFrom           As Worksheet
'
    MaxNumberOfDataFilesToBeUsed = 3                                                ' <--- Set this to the # of data files that you want to get data from
    SourceWorkbookSheetName = "Sheet1"                                              ' <--- Set this to the sheet name to copy data from
    Set DestinationWorkbookSheetToCopyTo = ThisWorkbook.Worksheets("MasterSheet")   ' <--- Set this to the sheet name to copy data to
'
    With DestinationWorkbookSheetToCopyTo.Range("A1:D1")                            ' Insert and Bold the Header for Destination Sheet
        .Value = Array("DATE", "NAME", "PRESS", "TEMP")
        .Font.Bold = True
    End With
'
    For SourceFileNumber = 1 To MaxNumberOfDataFilesToBeUsed                        ' Get data file paths/names Loop
        UserSelectedDataFileToOpen = Application.GetOpenFilename(Title:="Select File #" & SourceFileNumber & " of " & MaxNumberOfDataFilesToBeUsed & " files to Import Data from", FileFilter:="Excel Files (*.xls*), *xls*")
'
        If UserSelectedDataFileToOpen = "False" Then Exit Sub                                               ' Check to see if user clicked 'Cancel' or the 'X' button
'
                       Set SourceWorkbook = Workbooks.Open(UserSelectedDataFileToOpen)                      '   Open the selected data workbook
        Set SourceWorkbookSheetToCopyFrom = SourceWorkbook.Worksheets(SourceWorkbookSheetName)              '   Set the source workbook sheet name to copy data from
'
        LastRowDestinationWorkbookSheetToCopyTo = DestinationWorkbookSheetToCopyTo.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
           LastRowSourceWorkbookSheetToCopyFrom = SourceWorkbookSheetToCopyFrom.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
'
        DataDate = SourceWorkbookSheetToCopyFrom.Range("B1").Text                                               ' Grab the date from the data file worksheet

        For DataRowCounter = 3 To LastRowSourceWorkbookSheetToCopyFrom                                          ' Loop through the rows of data to copy from
            DestinationWorkbookSheetToCopyToRow = LastRowDestinationWorkbookSheetToCopyTo + DataRowCounter - 2  ' Set the row number to copy data to
'
            DestinationWorkbookSheetToCopyTo.Range("A" & DestinationWorkbookSheetToCopyToRow) = DataDate
            DestinationWorkbookSheetToCopyTo.Range("B" & DestinationWorkbookSheetToCopyToRow) = SourceWorkbookSheetToCopyFrom.Range("A" & DataRowCounter)
            DestinationWorkbookSheetToCopyTo.Range("C" & DestinationWorkbookSheetToCopyToRow) = SourceWorkbookSheetToCopyFrom.Range("C" & DataRowCounter)
            DestinationWorkbookSheetToCopyTo.Range("D" & DestinationWorkbookSheetToCopyToRow) = SourceWorkbookSheetToCopyFrom.Range("D" & DataRowCounter)
        Next
'
        SourceWorkbook.Close savechanges:=False                                                                 ' Close the data workbook without saving changes
    Next
'
    LastRowDestinationWorkbookSheetToCopyTo = DestinationWorkbookSheetToCopyTo.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
'
    With DestinationWorkbookSheetToCopyTo.Range("A1:D" & LastRowDestinationWorkbookSheetToCopyTo)               ' Center all the data in the Destination sheet
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
End Sub

Thank you so much Johnny... You really make my day. Excellent coding and explanation. Hopefully other Excel VBA beginner can benefit from this. Thank you again and stay safe always.

 

[johnnyL]

Your welcome @rozek. Glad it worked for you.

 

[rozek]

HI johnny. Just want to add a scenario. If we only want to paste only with value of TEMP > 100, how can we add this in the code? Once we identify this row, paste it under the existing data row in the destination sheet.

Thank you.

 

[johnnyL]

Working off of the previous code, I guess that would look something like the following:

Sub rozek_MasterSheet_UpdaterV2()
'
    Dim DataRowCounter                          As Long
    Dim DestinationWorkbookSheetToCopyToRow     As Long
    Dim LastRowDestinationWorkbookSheetToCopyTo As Long
    Dim MaxNumberOfDataFilesToBeUsed            As Long
    Dim SourceFileNumber                        As Long
    Dim DataDate                                As String
    Dim SourceWorkbookSheetName                 As String
    Dim UserSelectedDataFileToOpen              As String
    Dim SourceWorkbook                          As Workbook
    Dim DestinationWorkbookSheetToCopyTo        As Worksheet
    Dim SourceWorkbookSheetToCopyFrom           As Worksheet
'
    MaxNumberOfDataFilesToBeUsed = 3                                                ' <--- Set this to the # of data files that you want to get data from
    SourceWorkbookSheetName = "Sheet1"                                              ' <--- Set this to the sheet name to copy data from
    Set DestinationWorkbookSheetToCopyTo = ThisWorkbook.Worksheets("MasterSheet")   ' <--- Set this to the sheet name to copy data to
'
    With DestinationWorkbookSheetToCopyTo.Range("A1:D1")                            ' Insert and Bold the Header for Destination Sheet
        .Value = Array("DATE", "NAME", "PRESS", "TEMP")
        .Font.Bold = True
    End With
'
    For SourceFileNumber = 1 To MaxNumberOfDataFilesToBeUsed                        ' Get data file paths/names Loop
        UserSelectedDataFileToOpen = Application.GetOpenFilename(Title:="Select File #" & SourceFileNumber & " of " & MaxNumberOfDataFilesToBeUsed & " files to Import Data from", FileFilter:="Excel Files (*.xls*), *xls*")
'
        If UserSelectedDataFileToOpen = "False" Then Exit Sub                                               ' Check to see if user clicked 'Cancel' or the 'X' button
'
                       Set SourceWorkbook = Workbooks.Open(UserSelectedDataFileToOpen)                      '   Open the selected data workbook
        Set SourceWorkbookSheetToCopyFrom = SourceWorkbook.Worksheets(SourceWorkbookSheetName)              '   Set the source workbook sheet name to copy data from
'
        LastRowDestinationWorkbookSheetToCopyTo = DestinationWorkbookSheetToCopyTo.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
           LastRowSourceWorkbookSheetToCopyFrom = SourceWorkbookSheetToCopyFrom.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
'
        DataDate = SourceWorkbookSheetToCopyFrom.Range("B1").Text                                               ' Grab the date from the data file worksheet

        For DataRowCounter = 3 To LastRowSourceWorkbookSheetToCopyFrom                                          ' Loop through the rows of data to copy from
            If SourceWorkbookSheetToCopyFrom.Range("D" & DataRowCounter) > 100 Then                             '   Is the Source Temp > 100? If yes then ...
                DestinationWorkbookSheetToCopyToRow = LastRowDestinationWorkbookSheetToCopyTo + 1               '       Set the row number to copy data to
'
                DestinationWorkbookSheetToCopyTo.Range("A" & DestinationWorkbookSheetToCopyToRow) = DataDate
                DestinationWorkbookSheetToCopyTo.Range("B" & DestinationWorkbookSheetToCopyToRow) = SourceWorkbookSheetToCopyFrom.Range("A" & DataRowCounter)
                DestinationWorkbookSheetToCopyTo.Range("C" & DestinationWorkbookSheetToCopyToRow) = SourceWorkbookSheetToCopyFrom.Range("C" & DataRowCounter)
                DestinationWorkbookSheetToCopyTo.Range("D" & DestinationWorkbookSheetToCopyToRow) = SourceWorkbookSheetToCopyFrom.Range("D" & DataRowCounter)
            End If
        Next
'
        SourceWorkbook.Close savechanges:=False                                                                 ' Close the data workbook without saving changes
    Next
'
    LastRowDestinationWorkbookSheetToCopyTo = DestinationWorkbookSheetToCopyTo.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
'
    With DestinationWorkbookSheetToCopyTo.Range("A1:D" & LastRowDestinationWorkbookSheetToCopyTo)               ' Center all the data in the Destination sheet
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
End Sub