Copy a named range to another workbook

[Orfevre]

Hello, I have the below code where I am trying move away from using the cell ranges e.g. A2:A11 and use named ranges so if the range grows it still comes across, however it only copies over the first row but if I was to change it to the cell range it works fine. Looking for help on a way to make sure that if the range in the fromwork grows it will still be captured, does not have to be a named range if there is a better way.

Private Sub copydata()


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")

NextRowEmp = destSheet.Range("A" & destSheet.Rows.Count).End(xlUp).Row + 1
NextRowPAN = 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
NxtRwAllw = destSheet.Range("E" & destSheet.Rows.Count).End(xlUp).Row + 1
NxtRwMnth = destSheet.Range("F" & destSheet.Rows.Count).End(xlUp).Row + 1

matchWorkbooks = "D:\Source\09\01 End of Month\2022-2023\Temp\Data V5.xlsx"

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("FYFT")
destSheet.Range("A" & NextRowEmp).Offset(r).Value = .Range("EmpID").Value
destSheet.Range("B" & NextRowPAN).Offset(r).Value = .Range("PAN").Value
destSheet.Range("C" & NxtRwLast).Offset(r).Value = .Range("A2:A11").Value
destSheet.Range("D" & NxtRwFirst).Offset(r).Value = .Range("B2:B11").Value
destSheet.Range("E" & NxtRwAllw).Offset(r).Value = .Range("B2:B11").Value
destSheet.Range("F" & NxtRwMnth).Offset(r).Value = .Range("T2:T11").Value
End With
With fromWorkbook.Worksheets("Dashboard")
destSheet.Range("G3:G12").Offset(r).Value = .Range("D58").Value
destSheet.Range("H3:H12").Offset(r).Value = .Range("D52").Value
destSheet.Range("I3:I12").Offset(r).Value = .Range("O4").Value
destSheet.Range("J3:J12").Offset(r).Value = .Range("C3").Value

r = r + 1

End With
fromWorkbook.Close savechanges:=False
DoEvents
wbFileName = Dir
Wend
Application.ScreenUpdating = True

'MsgBox "Finished"

End Sub

 

[Zot]

Instead of

destSheet.Range("A" & NextRowEmp).Offset(r).Value = .Range("EmpID").Value

try

.Range("EmpID").Copy destSheet.Range("A" & NextRowEmp).Offset(r)

 

[Orfevre]

Instead of

destSheet.Range("A" & NextRowEmp).Offset(r).Value = .Range("EmpID").Value

try

.Range("EmpID").Copy destSheet.Range("A" & NextRowEmp).Offset(r)

Spectacular, thank you. One extra question how would I get it to just copy the values and not formatting?

 

[Zot]

Spectacular, thank you. One extra question how would I get it to just copy the values and not formatting?

You can use PasteSpecial

Example:

Range("A1").Copy Range("O1").PasteSpecial(xlPasteAllExceptBorders)
' or
Range("A1").Copy Range("O1").PasteSpecial(xlValue)