Macro button to copy data from other worksheets in the workbook to summary sheet

[cme]

Hi,

I am trying to create a macro that will extract data from all the worksheets in a workbook to a summary sheet (which occupies Sheet1).

In a nutshell, I have several worksheets in a file that I adjust individually from time to time, they all maintain the same exact format with same titles/columns, etc.; the data starts on row 14 of each of these worksheets and will have a date (MM/DD/YYYY) in column C along with paired information in the row (columns B through G). Some worksheets may only have 5 rows of data, others may have 80 rows of data, they are all different.

Now I have created a summary sheet and want to put a button that says "Update" and when I click it, it will go and search each worksheet from row 14 and down and if there is a value (or is not empty) then it will copy those details (B through G) to the summary page, one after another. Which then create a large database of all the Dates & Actions from all the worksheets that I can use to auto-filter.

Appreciate any and all guidance!!

 

[phantom1975]

I've sent you an email address in your private messages. I'm glad to help. By the way, I usually add a bit of code that speeds things up and eliminates the flicker. In fact, there are three things in the application that I "shut off" and then turn back on. The first is the ScreenUpdating. By turning this off, the screen does not redraw every time the image changes. The second is the EnableEvents. By turning this off, all event-related macros are disabled (for example, each time a new worksheet is selected the Worksheet_Activate macro runs.) The third is the DisplayAlerts. By turning this off, error messages will not be displayed. Below is the code to turn them off:

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
' I do it with a With statement
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    
End With

 

[Moe Kadhom]

Hi, I know this thread has not been active for years but I was wondering if anyone can help me with my issue.

I have below VBA that I took from another website. It goes through selected files in a folder and copies a range from all first sheets and puts it into one master sheet.

I want the code modified so it copies the range from ALL the sheets in each workbook. I have 17 workbooks with 9 sheets each. so the macro will copy the range from all the sheets in workbook one and copy them one after the other, then same for workbook 2 and so on.

can any one help me please?

Private Declare Function SetCurrentDirectoryA Lib _
    "kernel32" (ByVal lpPathName As String) As Long

Sub ChDirNet(szPath As String)
    SetCurrentDirectoryA szPath
End Sub


Sub MergeSpecificWorkbooks()
    Dim MyPath As String
    Dim SourceRcount As Long, FNum As Long
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim rnum As Long, CalcMode As Long
    Dim SaveDriveDir As String
    Dim FName As Variant


    ' Set application properties.
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    SaveDriveDir = CurDir
    ' Change this to the path\folder location of the files.
    ChDirNet "C:\Users\Ron\test"

    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
                                        MultiSelect:=True)
    If IsArray(FName) Then

        ' Add a new workbook with one sheet.
        Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
        rnum = 1


        ' Loop through all files in the myFiles array.
        For FNum = LBound(FName) To UBound(FName)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(FName(FNum))
            On Error GoTo 0

            If Not mybook Is Nothing Then

                On Error Resume Next
                With mybook.Worksheets(1)
                    Set sourceRange = .Range("A1:B120")
                End With

                If Err.Number > 0 Then
                    Err.Clear
                    Set sourceRange = Nothing
                Else
                    ' If the source range uses all columns then
                    ' skip this file.
                    If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
                        Set sourceRange = Nothing
                    End If
                End If
                On Error GoTo 0

                If Not sourceRange Is Nothing Then

                    SourceRcount = sourceRange.Rows.Count

                    If rnum + SourceRcount >= BaseWks.Rows.Count Then
                        MsgBox "There are not enough rows in the target worksheet."
                        BaseWks.Columns.AutoFit
                        mybook.Close savechanges:=False
                        GoTo ExitTheSub
                    Else

                        ' Copy the file name in column A.
                        With sourceRange
                            BaseWks.Cells(rnum, "A"). _
                                    Resize(.Rows.Count).Value = FName(FNum)
                        End With

                        ' Set the destination range.
                        Set destrange = BaseWks.Range("B" & rnum)

                        ' Copy the values from the source range
                        ' to the destination range.
                        With sourceRange
                            Set destrange = destrange. _
                                            Resize(.Rows.Count, .Columns.Count)
                        End With
                        destrange.Value = sourceRange.Value
                        rnum = rnum + SourceRcount
                    End If
                End If
                mybook.Close savechanges:=False
            End If

        Next FNum
        BaseWks.Columns.AutoFit
    End If

ExitTheSub:
    ' Restore the application properties.
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
    ChDirNet SaveDriveDir
End Sub

 

[Moid Khan]

Hi,
I have to compile distributors sales on daily basis. Sales files received through outlook. I want to record macro to copy all sales data from distributors to my master Sales File. anyone can guide me how can i record macro in order to compile sales.

I dnt know programming so that why i want to record macros.


Thanks & Regards,
Moid Khan