Copy data from Master Sheet to corresponding tab (some sheets may be blank)

surkdidat

Well-known Member
Joined
Oct 1, 2011
Messages
579
Office Version
  1. 2016
Hi there

I need some code please where it look at what is in column M and whatever is in this column, it copies the whole row (columns A to T) onto the relevant tab. Tabs are called Team1, Team2, Team3 etc to Team10. I tried recording a macro, filtering on column M and copying to the relevant tab, but this fails as when running the report there will be occasions where a certain Team will have no data to copy across.

This will be programmed into a button which will run the report. Before it does this, I need it to clear all the data, but I take it a simple select.Sheet, ClearAllContents A:T should do that part

Many thanks
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Code:
Sub MoveTeams()

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Sheets
    If ws.Name <> ActiveSheet.Name Then ws.Cells.Clear

Next

i = 1
Set StartSheet = ActiveSheet
Do Until StartSheet.Cells(i, 13) = ""
    Set ws = Sheets(Cells(i, 13).Value)
    With ws
        .Activate
        printrow = .Cells(Rows.Count, "A").End(xlUp).Row
        StartSheet.Range(StartSheet.Cells(i, 1), StartSheet.Cells(i, 20)).Copy .Cells(printrow, 1)
    
    End With


    i = i + 1

Loop

End Sub
 
Upvote 0
Hi there

Many thanks - I take it the i,13 bit relates to Column M - if I need the copying to start in A2, both on the main sheet with all the data in, and also for the tabs where the data goes to (ie their is column headers in cells A1:T1, how do I need to adjjust the below please?

Code:
Sub MoveTeams()

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Sheets
    If ws.Name <> ActiveSheet.Name Then ws.Cells.Clear

Next

i = 1
Set StartSheet = ActiveSheet
Do Until StartSheet.Cells(i, 13) = ""
    Set ws = Sheets(Cells(i, 13).Value)
    With ws
        .Activate
        printrow = .Cells(Rows.Count, "A").End(xlUp).Row
        StartSheet.Range(StartSheet.Cells(i, 1), StartSheet.Cells(i, 20)).Copy .Cells(printrow, 1)
    
    End With


    i = i + 1

Loop

End Sub
 
Upvote 0
This code uses a loop where i is the indicator of the first row it starts on. So we can start during the second row by initializing i with 2
i=2

If you do not want to remove the column headers on the later pages we need to adjust the ws.cells.clear as well to instead be a range from the 2nd row to the last row in the sheet.
If ws.Name <> ActiveSheet.Name Then ws.range(ws.rows(2),ws.rows(1048576)).clear

I have also added the following line incase your data doesn't have the headers already on the page:
if printrow=1 then printrow=2



Code:
Sub MoveTeams()

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Sheets
    If ws.Name <> ActiveSheet.Name Then ws.range(ws.rows(2),ws.rows(1048576)).clear

Next

i = 2

Set StartSheet = ActiveSheet
Do Until StartSheet.Cells(i, 13) = ""
    Set ws = Sheets(Cells(i, 13).Value)
    With ws
        .Activate
        printrow = .Cells(Rows.Count, "A").End(xlUp).Row

        if printrow=1 then printrow=2

        StartSheet.Range(StartSheet.Cells(i, 1), StartSheet.Cells(i, 20)).Copy .Cells(printrow, 1)
    
    End With


    i = i + 1

Loop

End Sub
 
Upvote 0
Hi there - I am still getting an error message on line Set ws = Sheets(Cells(i, 13).Value)

I would try and post an example workbook, but cannot figure out how to!
 
Upvote 0
Do all of the sheets exist?

Are they named exactly as they appear in column M?

when you get the error, can you hover your mouse over the "i" in the highlighted code and tell me what the value is?
 
Upvote 0
i=3

All Sheets exist, in the beta example I am running simply called Sheet1, Sheet2, Sheet3 .....Sheet10

I take it the fact that the values in column M can be in any order, ie the code can go from sheet to sheet in random order, and does not need to run from Sheet1 to Sheet10?
 
Upvote 0
This tells me it can find the sheet for the value in M2 but not in M3...

here is a modified version of the code, this one has error handling that will show a message box when ever it comes across a sheet name it can't find.

Code:
Sub MoveTeams()

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Sheets
    If ws.Name <> ActiveSheet.Name Then ws.Range(ws.Rows(2), ws.Rows(1048576)).Clear

Next

i = 2

Set StartSheet = ActiveSheet
Do Until StartSheet.Cells(i, 13) = ""
    foundsheet = ""
    For Each ws In ActiveWorkbook.Sheets
    If ws.Name = StartSheet.Cells(i, 13) Then
        Set ws = Sheets(Cells(i, 13).Value)
        Exit For
    End If

    Next

    If foundsheet = "" Then
        MsgBox ("Can not find sheet named: " & StartSheet.Cells(i, 13))
    Else
        
        With ws
            .Activate
            printrow = .Cells(Rows.Count, "A").End(xlUp).Row
    
            If printrow = 1 Then printrow = 2
    
            StartSheet.Range(StartSheet.Cells(i, 1), StartSheet.Cells(i, 20)).Copy .Cells(printrow, 1)
        
        End With
    End If

    i = i + 1

Loop

End Sub
 
Upvote 0
Hi there - thanks for all your help so far. I have gone in and ran in and its picking up an error on every line. I have gone in and renamed all the sheets and values in column M just incase I made an error, but still states Cannot find sheet named (lists all sheets in workbook) Is there anyway of uploading this to you, so you can see what is happening?
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,185
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top