Copy & paste multiple 'Named Ranges' from different worksheets to a new workbook using VBA

[kyip825excel]

Hi,

I need help with building a vba script that would copy & paste-append all of my data from their defined "Named ranges" from one workbook to a new workbook. The workbook where I'm copying from has multiple worksheets and they each have their own set of data with their own named ranges defined.

Can someone please help?

Thanks,

Ken

Partial script below (notice that it is repeated with difference worksheets and named ranges but I have over 50 of them so I need to be able to loop them or use Do Until all worksheets are copied):

Windows("JFajarta Mar Submission - Publishing.xlsx").Activate
Sheets("PiB").Select
Range("PiBrange").Copy
Windows("March Consolidation - JFajarta.xlsm").Activate
Sheets("Consolidate").Select
Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows("JFajarta Mar Submission - Publishing.xlsx").Activate
Sheets("PiB").Select
Range("PiBrangeNew").Copy

Windows("March Consolidation - JFajarta.xlsm").Activate
Sheets("Consolidate").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows("JFajarta Mar Submission - Publishing.xlsx").Activate
Sheets("Mad3").Select
Range("Mad3range").Copy
Windows("March Consolidation - JFajarta.xlsm").Activate
Sheets("Consolidate").Select
Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows("JFajarta Mar Submission - Publishing.xlsx").Activate
Sheets("Mad3").Select
Range("Mad3rangeNew").Copy

Windows("March Consolidation - JFajarta.xlsm").Activate
Sheets("Consolidate").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False