Copy from workbook and dynamically filldown data

[Orfevre]

Hi, I have below code that is copying from a excel file into a report, the issue I'm trying to fix is with the 3 lines below, it is set to row 26 as this is usually where the data to be filled down is pasted but I need to change this to update dynamically if there is new data above it e.g. one day it might be row 32, how can I make fill down the pasted data dynamically?

            destSheet.Range("G26:G" & destSheet.Range("A" & Rows.Count).End(xlUp).Row).FillDown
            destSheet.Range("H26:H" & destSheet.Range("A" & Rows.Count).End(xlUp).Row).FillDown
            destSheet.Range("J26:J" & destSheet.Range("A" & Rows.Count).End(xlUp).Row).FillDown

Private Sub Report()

    Dim matchWorkbooks As String
    Dim destSheet As Worksheet, r As Long
    Dim folderPath As String
    Dim wbFileName As String
    Dim fromWorkbook As Workbook
     
    'Define destination sheet
    Set destSheet = ActiveWorkbook.Worksheets("Individuals")
    
    NextRwEmp = destSheet.Range("A" & destSheet.Rows.Count).End(xlUp).Row + 1
    NextRwPAN = destSheet.Range("B" & destSheet.Rows.Count).End(xlUp).Row + 1
    NxtRwLast = destSheet.Range("C" & destSheet.Rows.Count).End(xlUp).Row + 1
    NxtRwFirst = destSheet.Range("D" & destSheet.Rows.Count).End(xlUp).Row + 1
    NxtRwFTE = destSheet.Range("E" & destSheet.Rows.Count).End(xlUp).Row + 1
    NxtRwAllw = destSheet.Range("G" & destSheet.Rows.Count).End(xlUp).Row + 1
    NxtRwPrac = destSheet.Range("F" & destSheet.Rows.Count).End(xlUp).Row + 1
    NxtRwFctr = destSheet.Range("H" & destSheet.Rows.Count).End(xlUp).Row + 1
    NxtRwPship = destSheet.Range("I" & destSheet.Rows.Count).End(xlUp).Row + 1
    NextrwMnth = destSheet.Range("J" & destSheet.Rows.Count).End(xlUp).Row + 1
              
    'Folder path and wildcard workbook files to import cells from
    'Change this
    matchWorkbooks = "D:\Reporting\V5.xlsm"
          
    r = 0
  
    Application.ScreenUpdating = False
          
    folderPath = Left(matchWorkbooks, InStrRev(matchWorkbooks, "\"))
    wbFileName = Dir(matchWorkbooks)
    While wbFileName <> vbNullString
        Set fromWorkbook = Workbooks.Open(folderPath & wbFileName)
        With fromWorkbook.Worksheets("NTE")
            .Range("ID").Copy destSheet.Range("A" & NextRwEmp).Offset(r)
            .Range("AN").Copy destSheet.Range("B" & NextRwPAN).Offset(r)
            .Range("Last").Copy destSheet.Range("C" & NxtRwLast).Offset(r)
            .Range("First").Copy destSheet.Range("D" & NxtRwFirst).Offset(r)
            .Range("TE").Copy
            destSheet.Range("E" & NxtRwFTE).PasteSpecial (xlPasteValuesAndNumberFormats)
            .Range("Partnership").Copy destSheet.Range("I" & NxtRwPship).Offset(r)
        End With
        With fromWorkbook.Worksheets("Summary")
            destSheet.Range("G" & NxtRwAllw).Offset(r).Value = .Range("D58").Value
            destSheet.Range("G26:G" & destSheet.Range("A" & Rows.Count).End(xlUp).Row).FillDown
            destSheet.Range("H" & NxtRwFctr).Offset(r).Value = .Range("D52").Value
            destSheet.Range("H26:H" & destSheet.Range("A" & Rows.Count).End(xlUp).Row).FillDown
            destSheet.Range("J" & NextrwMnth).Offset(r).Value = .Range("C3").Value
            destSheet.Range("J26:J" & destSheet.Range("A" & Rows.Count).End(xlUp).Row).FillDown
            r = r + 1
        End With
        fromWorkbook.Close savechanges:=False
        DoEvents
        wbFileName = Dir
    Wend
      
End Sub

 

[Alex Blakenburg]

I think we are going to need more information.
Most of your code relies on a counter "r" which is only incrementing by 1 for each workbook it opens.
This would indicate you are only copying in one row at a time and in that context Fill Down doesn't make sense.

If you really are intending to fill down what you just copied in as a Value couldn't you do it in one step ?

    With fromWorkbook.Worksheets("Summary")
        Dim LastRwEmp As Long, NxtRwAllw As Long
        LastRwEmp = destSheet.Range("A" & destSheet.Rows.Count).End(xlUp).Row
        NxtRwAllw = destSheet.Range("G" & destSheet.Rows.Count).End(xlUp).Row + 1
       
        destSheet.Range("G" & NxtRwAllw & ":G" & LastRwEmp).Value = .Range("D58").Value
        destSheet.Range("H" & NxtRwAllw & ":H" & LastRwEmp).Value = .Range("D52").Value
        destSheet.Range("J" & NxtRwAllw & ":J" & LastRwEmp).Value = .Range("C3").Value
    End With

 

[Orfevre]

I think we are going to need more information.
Most of your code relies on a counter "r" which is only incrementing by 1 for each workbook it opens.
This would indicate you are only copying in one row at a time and in that context Fill Down doesn't make sense.

If you really are intending to fill down what you just copied in as a Value couldn't you do it in one step ?

    With fromWorkbook.Worksheets("Summary")
        Dim LastRwEmp As Long, NxtRwAllw As Long
        LastRwEmp = destSheet.Range("A" & destSheet.Rows.Count).End(xlUp).Row
        NxtRwAllw = destSheet.Range("G" & destSheet.Rows.Count).End(xlUp).Row + 1
      
        destSheet.Range("G" & NxtRwAllw & ":G" & LastRwEmp).Value = .Range("D58").Value
        destSheet.Range("H" & NxtRwAllw & ":H" & LastRwEmp).Value = .Range("D52").Value
        destSheet.Range("J" & NxtRwAllw & ":J" & LastRwEmp).Value = .Range("C3").Value
    End With

Some of the data was a named range of a few rows but a few important pieces are just from one cell that needs to then be filled down on each row in the destsheet. This does exactly what I was after thank you.

 

[Alex Blakenburg]

Thanks for letting me know. Glad I could help.