Copy a Range of Data from Multiple Worksheets into a different Master Workbook

[kmarkle]

Hello- I have been searching for code that will help me copy a specific range of data from many worksheets within a workbook and paste it into a new workbook. I have worksheets names Day1-Day31 and I need to copy cells with data in the range from cells A69:C75 into the first blank row in a Master workbook. I know I can go back and forth activating the different workbooks and selecting each worksheet to accomplish this, but that would make for a very long code. Any advice would be appreciated. Thank you for you help in advance.

 

[Stridhan]

any other worksheets in that book or just Day1-Day31?

 

[MixedUpExcel]

Hi Kmarkle,

Try the code below:

It loops through all worksheets in the workbook and assuming that the only 2 sheets you don't want it to copy from are Master and Sheet1 (change if need be) then it will copy your range on each sheet and paste in the first blank cell in Column A on the Master Sheet.

Sub MasterSheet()


Dim LastRow As String
Dim ws As Worksheet


    For Each ws In ThisWorkbook.Worksheets
    
        If (ws.Name <> "Master") And (ws.Name <> "Sheet1") Then


    Sheets(ws.Name).Activate


    Range("A69:C75").Copy
    
    Sheets("Master").Activate
    
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With


    Range("A" & LastRow + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
   :=False, Transpose:=False


        End If
        
    Next ws
    
End Sub

Hope this helps.

Simon

 

[MixedUpExcel]

Hi Kmarkle,

I re-read your question and realised that you were saying that the Master Sheet wasn't on the same workbook as your Day 1 to Day 31.... so try this:

Make sure that you're Master Workbook isn't already open when you run this as it will ask you to open it (if it's open - it won't let you assign a name to use later in the code)

Sub MasterWorkbook()


Dim LastRow As String
Dim ws As Worksheet
Dim MasterWbk As String
Dim curWbk As String
curWbk = ActiveWorkbook.Name




    ChDrive "C"
    
    ChDir "C:\Users\Simon\Desktop\" ' put your own directory in here


    MYFILE = Application.GetOpenFilename("OPEN MASTER,*.*")
    
    Workbooks.Open Filename:= _
    MYFILE


    MasterWbk = ActiveWorkbook.Name


    Windows("" & curWbk).Activate


    For Each ws In ThisWorkbook.Worksheets
    
        If (ws.Name <> "Master") And (ws.Name <> "Sheet1") Then ' put the sheet names (if they are different in here - these will be in the Day 1 - Day 31 workbook


    Sheets(ws.Name).Activate


    Range("A69:C75").Copy
    
    Windows("" & MasterWbk).Activate
    
    Sheets("Sheet1").Activate
    
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With


    Range("A" & LastRow + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
   :=False, Transpose:=False


    Windows("" & curWbk).Activate


        End If
        
    Next ws
    
End Sub

There may be an easier / better way of writing this but it worked for me.

 

[kmarkle]

Hello- Thank you both for answering. I apologize for the delay in my response, but I was trying to figure it out on my own.

There are about 8 additional sheets in the workbook that I don't want to copy from.

Simon- I am trying your code but get a debugging error at

Sheets(ws.Name).Activate

Do I need to change Name to Master?

If you can remind me how to post code properly in this site I would also appreciate that.
Thank you again for your help.