Copying Excel data from multiple worksheets into one single sheet

Question

I have tried searching the internet for various answers to this question but cannot find the right answer. I have an Excel Workbook with worksheets represent each day of the

Answer 1

Sub AddToMaster()
'this macro goes IN the master workbook
Dim wsMaster As Worksheet, wbDATA As Workbook
Dim NextRow As Long, LastRow As Long
Dim FileName As String
Dim FolderPath As String
Dim n As Long
Dim i


Set wsMaster = ThisWorkbook.Sheets("Sheet1")

'Specify the folder path

FolderPath = "D:\work\"

'specifying file name

 FileName = Dir(FolderPath & "*.xls*")

Do While FileName <> ""

NextRow = wsMaster.Range("A" & Rows.Count).End(xlUp).Row + 1

Set wbDATA = Workbooks.Open(FolderPath & FileName)

    With wbDATA.Sheets("product_details")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
       ' If LastRow > 5 Then
        For i = 2 To LastRow

            .Range("A2:j" & i).Copy
            wsMaster.Range("A" & NextRow).PasteSpecial xlPasteValues
            'Set NextRow = NextRow
        Next i
    End With
  FileName = Dir()
    Loop

wbDATA.Close False
End Sub

Answer 2

MASSIVE EDIT:

As with last chat with Iain, the correct parameters have been set. I have removed the last few code snippets as they are quite not right. If anyone is still interested, please check the edit history.

Hopefully, this is the final edit. ;)

So, the correct conditions needed are:

1. Month name in sheet. We used an Input Box for this.
2. We check for number of rows. There are three conditions: 157 rows total, 41 rows total, and all else.

The following subroutine will do the trick.

Sub BlackwoodTransfer()

    Dim Summ As Worksheet, Ws As Worksheet
    Dim ShName As String
    Dim nRow As Long

    Set Summ = ThisWorkbook.Sheets("Summary")
    ShName = InputBox("Enter month for Call Flow in mmmm format (ie. November, etc.):") & " Call Flow"
    'Returns November Call Flow. This means it will target every sheet that has November Call Flow in its name.

    Application.ScreenUpdating = False

    For Each Ws In ThisWorkbook.Worksheets
        If InStr(1, Ws.Name, ShName) > 0 Then
        'Starting from first character of the sheet's name, if it has November, then...
            nRow = Summ.Cells(Rows.Count, 1).End(xlUp).Row + 1
            '... get the next empty row of the Summary sheet...
            Select Case Ws.Cells(Rows.Count, 1).End(xlUp).Row
            '... check how many rows this qualified sheet has...
                Case 157
                '... if there are 157 rows total...
                    Ws.Range(Cells(57,1),Cells(104,13)).Copy
                    '... copy Rows 57 to 104, 13 columns wide...
                    Summ.Range("A" & nRow).PasteSpecial xlPasteAll
                    '... and paste to next empty row in Summary sheet.
                Case 41
                    Ws.Range(Cells(23,1),Cells(126,13)).Copy
                    Summ.Range("A" & nRow).PasteSpecial xlPasteAll               
                Case Else
                    Ws.Range(Cells(23,1),Cells(30,13)).Copy
                    Summ.Range("A" & nRow).PasteSpecial xlPasteAll
            End Select
        End If
    Next Ws

    Application.ScreenUpdating = True

End Sub

@Iain: Check out the comments and cross reference them with the MSDN database. That should explain what each function/method is doing exactly. Hope this helps!

Answer 3

Sub CombineSheets()
   Dim ws As Worksheet, wsCombine As Worksheet
   Dim rg As Range
   Dim RowCombine As Integer

   Set wsCombine = ThisWorkbook.Worksheets.Add(ThisWorkbook.Worksheets(1))
   wsCombine.Name = "Combine"

   RowCombine = 1
   For Each ws In ThisWorkbook.Worksheets
      If ws.Index <> 1 Then
         Set rg = ws.Cells(1, 1).CurrentRegion
         rg.Copy wsCombine.Cells(RowCombine, 2)
         wsCombine.Range(Cells(RowCombine, 1), Cells(RowCombine + rg.Rows.Count - 1, 1)) = ws.Name
         RowCombine = RowCombine + rg.Rows.Count
      End If
   Next
   wsCombine.Cells(1, 1).EntireColumn.AutoFit
   Set rg = Nothing
   Set wsCombine = Nothing
End Sub

Answer 4

Create a worksheet "Summary" which is to contain all the merged data. Open ThisWorkBook (simply press ALT+F11 in your excel workbook. A new window will open. Your worksheet name will be visible on the left hand side. Keep expanding till you see ThisWorkBook) Double click ThisWorkBook and add the following code in it:

Sub SummurizeSheets() 
    Dim ws As Worksheet 

    Application.Screenupdating = False 
    Sheets("Summary").Activate 

    For Each ws In Worksheets 
        If ws.Name <> "Summary" Then 
            ws.Range("F46:O47").Copy 
            ActiveSheet.Paste Range("A65536").End(xlUp).Offset(1, 0) 
        End If 
    Next ws 
End Sub