VBA code mod to copy 4 ranges on a sheet to summary sheets

Question

Hi im looking for a code like this but i need to set a range say B4 to M35 to be copied to a sheet which will then drive a pivot table, also i find this code keeps over-writting the previous copied data so i need this to find empty rows to paste to. so on say a sheet named day1 i will need by means of adding macro to a button for each range to copy a range from B4 to J35. to a summary. Then again on another seperate summary sheet i would need say range B40 to M70. Then again B75 to M105 to another sheet and B110 to M140 to another sheet.

Then i need to copy the same code to other sheets day2 , day3 , day4

at the end of the 4 days i would then have 4 summary sheets from the four ranges from each sheet to then drive a pivot table from each summary sheet which will be increased each time a range is saved each day.

Sub CopyRows1()
Dim bottomL As Integer
Dim x As Integer
bottomL = Sheets("day1").Range("A" & ROWS.Count).End(XLUP).Row: x = 1

Dim c As Range
For Each c In Sheets("day1").Range("A4:A" & bottomL)
    If c.Value >= "" Then
        c.EntireRow.Copy Worksheets("sheet1").Range("A" & x)
        x = x + 1
    End If
Next c

End Sub

D_Zab D_Zab · Accepted Answer · 2015-01-09T16:51:35

It is a little confusing, but I think you are saying that for each day you will have multiple buttons. Each one will be assigned a section from that day and will write that section into a separate summary sheet?

Try this, it would involve setting up a separate macro for each button that designate the range you want to copy and which summary sheet you want it to go to:

Sub ButtonDay1()
    Dim wsSource As Worksheet
    Dim ThisDayRange As Range

    Set wsSource = ActiveSheet
    'Set this to the range you want to move to a summary sheet
    Set ThisDayRange = wsSource.Range("B4:M35")

    'Call the AddToSummary function to send to the desired sheet
    AddToSummary ThisDayRange, Sheets("Summary1")

End Sub

Then call this function to write it:

Function AddToSummary(DayRange As Range, SummarySheet As Worksheet)
    Dim AddRow As Integer
    Dim Item As Range
    Dim i As Integer

    AddRow = SummarySheet.UsedRange.Rows.Count
    If AddRow <> 1 Then
        AddRow = AddRow + 1
    End If

    For i = 1 To DayRange.Rows.Count
        If DayRange.Cells(i, 1).Value <> "" Then
            For b = 1 To DayRange.Columns.Count
                SummarySheet.Cells(AddRow, b).Value = DayRange.Cells(i, b).Value
            Next b

            AddRow = AddRow + 1
        End If
    Next i

End Function

If you wanted to just re-use the same macro for each button you could write an input box that asks for the range and summary sheet values

VBA code mod to copy 4 ranges on a sheet to summary sheets

1 Answers