Combine Multiple Worksheets

[Nanogirl21]

I have 1 workbook with 8 worksheets. All worksheets are set up in the same format using columns A - Y. Is there any way that I can easily combine all worksheets into 1? On the new worksheet in column A I'd like the name of the orginal worksheet and the actual data to be from coumn B - Z. Thank you for the help.

 

[Nanogirl21]

I know I did not recieve a response to my post, but I was able to figure out the soloution. I just have to add an extra column in the orginal worksheets that have the sheet name. Here is the code just incase someone else ever needs it.

<code class="vb keyword">Sub</code> <code class="vb plain">CombineMultipleWorksheets()</code>

<code class="vb spaces">    </code><code class="vb keyword">Dim</code> <code class="vb plain">i </code><code class="vb keyword">As</code> <code class="vb keyword">Integer</code>
<code class="vb spaces">    </code><code class="vb keyword">Dim</code> <code class="vb plain">xTCount </code><code class="vb keyword">As</code> <code class="vb keyword">Variant</code>
<code class="vb spaces">    </code><code class="vb keyword">Dim</code> <code class="vb plain">xWs </code><code class="vb keyword">As</code> <code class="vb plain">Worksheet</code>
<code class="vb spaces">    </code><code class="vb keyword">On</code> <code class="vb keyword">Error</code> <code class="vb keyword">Resume</code> <code class="vb keyword">Next</code>
<code class="vb plain">LInput:</code>
<code class="vb spaces">    </code><code class="vb plain">xTCount = Application.InputBox(</code><code class="vb string">"The number of title rows"</code><code class="vb plain">, </code><code class="vb string">""</code><code class="vb plain">, </code><code class="vb string">"1"</code><code class="vb plain">)</code>
<code class="vb spaces">    </code><code class="vb keyword">If</code> <code class="vb plain">TypeName(xTCount) = </code><code class="vb string">"Boolean"</code> <code class="vb keyword">Then</code> <code class="vb keyword">Exit</code> <code class="vb keyword">Sub</code>
<code class="vb spaces">    </code><code class="vb keyword">If</code> <code class="vb keyword">Not</code> <code class="vb plain">IsNumeric(xTCount) </code><code class="vb keyword">Then</code>
<code class="vb spaces">        </code><code class="vb plain">MsgBox </code><code class="vb string">"Only can enter number"</code><code class="vb plain">, , </code><code class="vb string">"Kutools for Excel"</code>
<code class="vb spaces">        </code><code class="vb keyword">GoTo</code> <code class="vb plain">LInput</code>
<code class="vb spaces">    </code><code class="vb keyword">End</code> <code class="vb keyword">If</code>
<code class="vb spaces">    </code><code class="vb keyword">Set</code> <code class="vb plain">xWs = ActiveWorkbook.Worksheets.Add(Sheets(1))</code>
<code class="vb spaces">    </code><code class="vb plain">xWs.Name = </code><code class="vb string">"Combined"</code>
<code class="vb spaces">    </code><code class="vb plain">Worksheets(2).Range(</code><code class="vb string">"A1"</code><code class="vb plain">).EntireRow.Copy Destination:=xWs.Range(</code><code class="vb string">"A1"</code><code class="vb plain">)</code>
<code class="vb spaces">    </code><code class="vb keyword">For</code> <code class="vb plain">i = 2 </code><code class="vb keyword">To</code> <code class="vb plain">Worksheets.Count</code>
<code class="vb spaces">        </code><code class="vb plain">Worksheets(i).Range(</code><code class="vb string">"A1"</code><code class="vb plain">).CurrentRegion.Offset(</code><code class="vb keyword">CInt</code><code class="vb plain">(xTCount), 0).Copy _</code>
<code class="vb spaces">               </code><code class="vb plain">Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).Row + 1, 1)</code>
<code class="vb spaces">    </code><code class="vb keyword">Next</code>
<code class="vb keyword">End</code> <code class="vb keyword">Sub</code>

 

[vcoolio]

Hello Nanogirl,

I just picked up on your thread and here's another option for you (including placing the source sheet names in Column A of the Combined sheet):-

Sub Test()

        Dim ws As Worksheet
        Dim sh As Worksheet: Set sh = Sheets("Combined")
        Dim lr As Long, sr As Long

Application.ScreenUpdating = False

For Each ws In Worksheets
        If ws.Name <> "Combined" Then
        ws.[A1].CurrentRegion.Offset(1).Copy sh.Range("B" & Rows.Count).End(3)(2)
        lr = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row
        sr = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row + 1
        sh.Range("A" & sr & ":A" & lr) = ws.Name
        End If
Next ws

Application.ScreenUpdating = True

End Sub

I'm assuming that you have the "Combined" sheet already created.

Its also good to see that you made the effort to sort this out for yourself.

I hope that this helps.

Cheerio,
vcoolio.

 

[Nanogirl21]

Thank you! This is very helpful.

 

[Nanogirl21]

Hello Nanogirl,

I just picked up on your thread and here's another option for you (including placing the source sheet names in Column A of the Combined sheet):-

Sub Test()

        Dim ws As Worksheet
        Dim sh As Worksheet: Set sh = Sheets("Combined")
        Dim lr As Long, sr As Long

Application.ScreenUpdating = False

For Each ws In Worksheets
        If ws.Name <> "Combined" Then
        ws.[A1].CurrentRegion.Offset(1).Copy sh.Range("B" & Rows.Count).End(3)(2)
        lr = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row
        sr = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row + 1
        sh.Range("A" & sr & ":A" & lr) = ws.Name
        End If
Next ws

Application.ScreenUpdating = True

End Sub

I'm assuming that you have the "Combined" sheet already created.

Its also good to see that you made the effort to sort this out for yourself.

I hope that this helps.

Cheerio,
vcoolio.

I just tested your code. It did not bring over the headers that is in row 1. The headers are the same in all worksheets. How would I do this?

 

[vcoolio]

Hello Nanogirl,

I had assumed that you had placed the headings in Row1 of the already created "Combined" sheet.
Do you mean that you would like the headings from ALL the worksheets transferred to the "Combined" sheet as well? If so, I don't see the point as you would only need to have headings in Row1 of the Combined sheet and then freeze Row1 so that you can scroll beneath Row1.

Regardless, please confirm what you would like to do.

Cheerio,
vcoolio.

 

[alansidman]

Have you considered using Power Query. Quick and simple to achieve what you are looking to do. Look at this video.

https://www.youtube.com/watch?v=LSDQGWdgNJs

 

[Nanogirl21]

Have you considered using Power Query. Quick and simple to achieve what you are looking to do. Look at this video.

https://www.youtube.com/watch?v=LSDQGWdgNJs

Correct me if i'm wrong, but inorder for power query to work your data have to be in the table formatting set up. I do not want to format my data that way. power query may be easier, but the data that I am using I cannot reformat. I just need to merge the sheets so I can do my modifications in the new combined page. Thanks.

 

[Nanogirl21]

Hello Nanogirl,

I had assumed that you had placed the headings in Row1 of the already created "Combined" sheet.
Do you mean that you would like the headings from ALL the worksheets transferred to the "Combined" sheet as well? If so, I don't see the point as you would only need to have headings in Row1 of the Combined sheet and then freeze Row1 so that you can scroll beneath Row1.

Regardless, please confirm what you would like to do.

Cheerio,
vcoolio.

Hi,

No, I just need the headings from 1 of the sheets. I modified your code to add a new sheet called "Combined". I can add a paste of the 1st row of the first sheet in the workbook to the new sheet starting in cell B2 since I only need the headings 1 time. However, the first sheet in the workbook name will always be different, so i'm not sure how to do that.

Thanks!

Combine_Worksheets()

Application.ScreenUpdating = False

Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Combined"

        Dim ws As Worksheet
        Dim sh As Worksheet: Set sh = Sheets("Combined")
        Dim lr As Long, sr As Long
        
For Each ws In Worksheets
        If ws.Name <> "Combined" Then
        ws.[A1].CurrentRegion.Offset(1).Copy sh.Range("B" & Rows.Count).End(3)(2)
        lr = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row
        sr = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row + 1
        sh.Range("A" & sr & ":A" & lr) = ws.Name
        End If
Next ws


Application.ScreenUpdating = True

End Sub

 

[vcoolio]

Hello Nanogirl,

Try it as follows:-

Sub Test()

        Dim ws As Worksheet
        Dim sh As Worksheet: Set sh = Sheets("Combined")
        Dim lr As Long, sr As Long

Application.ScreenUpdating = False

For Each ws In Worksheets
        ws.[A1:L1].Copy sh.[B1]  '---->Change L1 to whatever your last column is (V1 I think?)
        sh.[A1] = "Source Sheet"
        If ws.Name <> "Combined" Then
        ws.[A1].CurrentRegion.Offset(1).Copy sh.Range("B" & Rows.Count).End(3)(2)
        lr = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row
        sr = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row + 1
        sh.Range("A" & sr & ":A" & lr) = ws.Name
        End If
Next ws

sh.Columns.AutoFit

Application.ScreenUpdating = True

End Sub

I haven't added your create sheet line of code above. I'll leave that to you.

I hope that this helps.

Cheerio,
vcoolio.