locked
Append selection of data from a selection of worksheets RRS feed

  • Question

  • Hi people,

    i am currently working on a way to merge my daily data collection into a "master"/monthly sheet without having to copy and pasta each days data.

    i have found

    Sub CopyFromWorksheets()
        Dim wrk As Workbook 'Workbook object - Always good to work with object variables
        Dim sht As Worksheet 'Object for handling worksheets in loop
        Dim trg As Worksheet 'Master Worksheet
        Dim rng As Range 'Range object
        Dim colCount As Integer 'Column count in tables in the worksheets
        
        Set wrk = ActiveWorkbook 'Working in active workbook
        
        For Each sht In wrk.Worksheets
            If sht.Name = "Master" Then
                MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
                "Please remove or rename this worksheet since 'Master' would be" & _
                "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
                Exit Sub
            End If
        Next sht
        
         'We don't want screen updating
        Application.ScreenUpdating = False
        
         'Add new worksheet as the last worksheet
        Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
         'Rename the new worksheet
        trg.Name = "Master"
         'Get column headers from the first worksheet
         'Column count first
        Set sht = wrk.Worksheets(1)
        colCount = sht.Cells(1, 255).End(xlToLeft).Column
         'Now retrieve headers, no copy&paste needed
        With trg.Cells(1, 1).Resize(1, colCount)
            .Value = sht.Cells(1, 1).Resize(1, colCount).Value
             'Set font as bold
            .Font.Bold = True
        End With
        
         'We can start loop
        For Each sht In wrk.Worksheets
             'If worksheet in loop is the last one, stop execution (it is Master worksheet)
            If sht.Index = wrk.Worksheets.Count Then
                Exit For
            End If
             'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
            Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
             'Put data into the Master worksheet
            trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
        Next sht
         'Fit the columns in Master worksheet
        trg.Columns.AutoFit
        
         'Screen updating should be activated
        Application.ScreenUpdating = True
    End Sub

     this code works, but it grabs all the data from every sheet. my problem is that i have a daily summary box at the bottom of each days table, which is adds to my master sheet, and i also have 3 sheets at the end of the workbook that i dont want adding.

    What i would like it to be able to only take the data froim the daily tabs (name "1st", "2nd" , "3rd" etc. and to only collect rows 3-201 (row 2 is used on a freeze frame for a notification alert, and row 1 is of course the title row.

    Any help would be appreciated,

    Regards

    Shmiggle

    Monday, September 22, 2014 12:42 PM

Answers

  • Hello,

    in this line code all you go throught every worksheet:

     'We can start loop
        For Each sht In wrk.Worksheets
             'If worksheet in loop is the last one, stop execution (it is Master worksheet)
            If sht.Index = wrk.Worksheets.Count Then
                Exit For
            End If
             'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
            Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
             'Put data into the Master worksheet
            trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
        Next sht

    I don't know how dynamic you want this to go? take every sheet but your master? Or take every sheet that starts with a number?

    Eitherway you could put an If in you for-loop and select the sheets

     'We can start loop
        For Each sht In wrk.Worksheets

           if left(sht.name,1) > 0 and  left(sht.name,1) <=9 then

             'If worksheet in loop is the last one, stop execution (it is Master worksheet)
            If sht.Index = wrk.Worksheets.Count Then
                Exit For
            End If
             'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
            Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
             'Put data into the Master worksheet
            trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value

    end if

        Next sht

    for you number of rows, replace 65536 by 200.

    hope this works for you

    Monday, September 22, 2014 12:55 PM