Cell Range From many to 1

[Celledor]

I have been working on a code that i just cant get right.

I am sure the correct macro is here somewhwere, i just cant find it. I am working with 1400+ sheets in 1 workbook. I need to be able to cope a cell range from each sheet to one master sheet. and i need to be able to do it 3 times. or one macro that will do it all in one pass and know where each new row in the master came from.

i.e. Cells A9:P9, K11:P11, and K13:P13 into the same row of the master sheet. (these are the actual cells, not an example.)

Any help is appreciated. i do not need to update the data as the week goes on. this is a new workbook every sunday. Cells are forever the same. Thank you all.

 

[My Aswer Is This]

So we will have 28 columns of data pasted into each row in sheet (1) is that correct.

And the Master sheet will be sheet(1) which is the sheet in the far left position on the Workbook tab bar.

You said:
"and know where each new row in the master came from"

Do you mean the sheet name where the data came from. If so in what column will the sheet name go into?

 

[My Aswer Is This]

Assuming the Master Sheet will be sheet(1)
The sheet in the far left position in the Workbook

Try this script:

Sub Test_Me()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Sheets(1).Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row + 1

    For i = 2 To Sheets.Count
        Sheets(1).Cells(Lastrow, 1).Value = Sheets(i).Name
        Sheets(i).Range("A9:P9").Copy Destination:=Sheets(1).Cells(Lastrow, 2)
        Sheets(i).Range("K11:P11").Copy Destination:=Sheets(1).Cells(Lastrow, 18)
        Sheets(i).Range("K13:P13").Copy Destination:=Sheets(1).Cells(Lastrow, 24)
        Lastrow = Lastrow + 1
    Next

Application.ScreenUpdating = True
End Sub

 

[bhos123]

Sub Macro2()

Dim ws As Worksheet
Dim i As Long
i = 0
Application.ScreenUpdating = False

Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Summary"

For Each ws In ActiveWorkbook.Worksheets
i = i + 1
ws.Select
Range("A9:P9").Select
Selection.Copy
Sheets("Summary").Select
Range("A8").Offset(i, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ws.Select
Range("K11:P11").Select
Selection.Copy
Sheets("Summary").Select
Range("R8").Offset(i, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ws.Select
Range("K13:P13").Select
Selection.Copy
Sheets("Summary").Select
Range("Y8").Offset(i, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Next
Application.ScreenUpdating = True
End Sub


Copies the A9:P9 to A9:P9 in Summary Worksheet
Copies K11 to P11 to R9:W9 in Summary Worksheet
Copies K13 to P13 to Y9 to AD9 in Summary Worksheet

for the Next sheet the pasting will be done on 10th row,next to next sheet to 11th and so on.