combining two sheets into one

[merryperson]

I have two worksheets in a workbook called Sheet 1 Sheet 2 ( I could change the names if that would make life easier say to 1 and 2 )

Each sheet is identical with 10 columns and for example sheet 1 comprises 20 lines and sheet 2, 30 lines
Column A Name
Column B Address 1
Column C Address 2
Column D Address 3
Coliumn E Address 4
Column F Postcode
Column G Date Of birth
Column H Telephone work
Column I Telephone Home
Column J Mobile
I wish to combine the two sheets to make the one sheet with the 10 columns but include the 50 lines.
I can do it my cutting and pasting but there must be an easier way
Anybody ??????????
I wish to

 

[MrKowz]

If this is a one-time thing, I'd reccomend just cutting and pasting. Otherwise, if you will need to do this task multiple times, a macro can be done.

 

[merryperson]

Unfortunately its going to be a regular thing and may escalate if there is an easy way to do it for other functions in the office using the same principle

 

[JackDanIce]

Assuming you only have two sheets, named Sheet1 and Sheet2 and you're happy with all the data to be put into Sheet1, try:

Sub CombineData ()
With Sheets("Sheet2")
    .Range("A2:J" & .Range("A" & Rows.Count).End(xlUp).Row).Copy
End With
With Sheets("Sheet1")
    .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End With
End Sub

 

[MrKowz]

Try this code out. It should universally work to consolidate workbooks of varying length. It will create a worksheet called "Master" and consolidate everything to that. It also will ask you if you want to include a header row (which it will pull from the last sheet if you say "Yes")

Public Sub ConsolidateWorkbook()
'Variable Declaration: dWS = Destination Worksheet, sLR = Source Worksheet Last Row
'                      dLR = Destination Last Row
Dim ws          As Worksheet, _
    dWS         As Worksheet, _
    sLR         As Long, _
    dLR         As Long, _
    RowHeader   As VbMsgBoxResult
    
Application.ScreenUpdating = False
Sheets.Add Before:=Sheets(1)
ActiveSheet.Name = "Master"
Set dWS = ActiveWorksheet
RowHeader = MsgBox("Do your worksheets contain a header?", vbYesNo)
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> dWS.Name Then
        dLR = dWS.Range("A" & Rows.Count).End(xlUp).row + 1
        sLR = ws.Range("A" & Rows.Count).End(xlUp).row
        Select Case RowHeader
            Case vbYes
                ws.Range("A2:A" & sLR).EntireRow.Copy Destination:=dWS.Range("A" & dLR)
            Case vbNo
                ws.Range("A1:A" & sLR).EntireRow.Copy Destination:=dWS.Range("A" & dLR)
        End Select
    Else
        If RowHeader = vbYes Then Sheets(Sheets.Count).Rows(1).Copy Destination:=dWS.Range("A1")
    End If
Next ws
Application.ScreenUpdating = True
End Sub

 

[merryperson]

I have the two worksheets Sheet1 and Sheet2 and have copied the macro above and used it.Unfortunately i get an error on the "Set dWS = ActiveWorksheet" code.
What am I doing wrong or what does need to be done to correct this ?

 

[MrKowz]

Try:

Public Sub ConsolidateWorkbook()
'Variable Declaration: dWS = Destination Worksheet, sLR = Source Worksheet Last Row
'                      dLR = Destination Last Row
Dim ws          As Worksheet, _
    dWS         As Worksheet, _
    sLR         As Long, _
    dLR         As Long, _
    RowHeader   As VbMsgBoxResult
    
Application.ScreenUpdating = False
Sheets.Add Before:=Sheets(1)
ActiveSheet.Name = "Master"
Set dWS = ActiveSheet
RowHeader = MsgBox("Do your worksheets contain a header?", vbYesNo)
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> dWS.Name Then
        dLR = dWS.Range("A" & Rows.Count).End(xlUp).row + 1
        sLR = ws.Range("A" & Rows.Count).End(xlUp).row
        Select Case RowHeader
            Case vbYes
                ws.Range("A2:A" & sLR).EntireRow.Copy Destination:=dWS.Range("A" & dLR)
            Case vbNo
                ws.Range("A1:A" & sLR).EntireRow.Copy Destination:=dWS.Range("A" & dLR)
        End Select
    Else
        If RowHeader = vbYes Then Sheets(Sheets.Count).Rows(1).Copy Destination:=dWS.Range("A1")
    End If
Next ws
Application.ScreenUpdating = True
End Sub

 

[merryperson]

Excellent thats works a treat many thanks