copy and paste cell range from 2 sheets from a value on another sheet

[diehippy]

Hi All,

I am stuggling vith the following vba code to copy and paste rows of data from 2 spreadsheets to one spreadsheet from a value in another spreadsheet. The reason I have been asked to do this is that 19151 rows of data that are group accoding to a code and I would like to automate the copying to save time. If any one can help I would be most grateful

Here is the code

Sub create_report()
'
' create_report Macro
'

'
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("$A$19:$O$32").Select
Selection.ClearContents
Range("A15:J15").Select
Selection.ClearContents
Range("A8:O9").Select
Selection.ClearContents
Range("A5:H6").Select
Selection.ClearContents
ActiveWorkbook.SaveAs Filename:="N:\full_data_learner_check.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

'select name to use for filter
Sheets("courselist").Select

ActiveCell.Select
Name = Selection.Value
'ActiveCell.Offset(1, 0).Range("C4").Select

Selection.Copy

'Sheets("parent child ").Select
'Range("A4:M5").Select
'filter according to name variable

Sheets("parent child").Select
ActiveSheet.Range("$A$4:$M$1443").AutoFilter Field:=1, Criteria1:="=" & Name & "", _
Operator:=xlAnd
Cells.Select
Application.CutCopyMode = False

Selection.Copy
Sheets("Sheet1").Select
Range("A21").Select
ActiveSheet.Paste
Range("A22").Select
Application.CutCopyMode = False
Selection.Cut Destination:=Range("A5")
Range("B22").Select
Selection.Cut Destination:=Range("A8")
Range("C22").Select
Selection.Cut Destination:=Range("C5")
Range("D22").Select
Selection.Cut Destination:=Range("C8")
Range("E22").Select
Selection.Cut Destination:=Range("G5")
Range("F22").Select
Selection.Cut Destination:=Range("H8")
Range("G22").Select
Selection.Cut Destination:=Range("K8")
Range("H22").Select
Selection.Cut Destination:=Range("N8")
Range("I22").Select
Selection.Cut Destination:=Range("A15")
Range("J22").Select
Selection.Cut Destination:=Range("C15")
Range("K22").Select
Selection.Cut Destination:=Range("F15")
Range("L22").Select
Selection.Cut Destination:=Range("H15")
Range("M22").Select
Selection.Cut Destination:=Range("J15")
Rows("21:21").Select
Selection.ClearContents
Range("A210").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -4.99893185216834E-02
.PatternTintAndShade = 0
End With
Range("A1417").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Range("A15:J15").Select
Selection.Font.Bold = True
With Selection.Font
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Columns("H:H").ColumnWidth = 15.86
Range("C22").Select
'Sheets("learners").Select

'filter according to name variable
Sheets("learners").Select
ActiveSheet.Range("$V$5:$AJ$19152").AutoFilter Field:=1, Criteria1:="=" & Name & "", _
Operator:=xlAnd
Cells.Select
Application.CutCopyMode = False

Selection.Copy
Sheets("Sheet1").Select
Range("A19").Select
ActiveSheet.Paste
Columns("D").ColumnWidth = 10.57
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
Cells.Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Sheet2").Select
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet3").Select
ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.SaveAs Filename:="N:\report_test.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False

Many Thanks

Mark

 

[SkipVought]

diehippy,

Is something not working?

What specific thing do you need help with?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[diehippy]

Hi skipVought,

Thanks for the response,
Yes I keep getting an error 'Run-time error 9 Subscript out of range on line 19 'Sheets("parent child").Select'I am just a beginner in VBA what I have done is try to stick various macros together but have failed badly I have tried eveywhere to find some similar code that I could work through the problem with but I have been unable to.

Many Thanks

Mark