PDA

View Full Version : [SOLVED] VBA problem: Merge two sheets into one



Dutchyb
11-08-2017, 11:06 AM
Good evening,

As a Newbie her, I hope some one is willing to help me. I downloaded a VBA script from this website. It is a script to merge two sheets into one.
It is only partly working.
From the description it says it should copy one header and add the data would be copied under the rest. But for some reason the header of the 2nd sheet is copied and only the first row.

I am using Office 365 for Mac.

I don't know if it is allowed but here is the code:


Thanks for the help
Dutchyb
Sub CopyFromWorksheets()Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim trg As Worksheet 'Master Worksheet
Dim rng As Range 'Range object
Dim colCount AsInteger'Column count in tables in the worksheets

Set wrk = ActiveWorkbook 'Working in active workbook

For Each sht In wrk.Worksheets
If sht.Name = "Master" Then
MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
"Please remove or rename this worksheet since 'Master' would be" & _
"the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
Exit Sub
End If
Next sht

'We don't want screen updating
Application.ScreenUpdating = False

'Add new worksheet as the last worksheet
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
'Rename the new worksheet
trg.Name = "Master"
'Get column headers from the first worksheet
'Column count first
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(1, 255).End(xlToLeft).Column
'Now retrieve headers, no copy&paste needed
With trg.Cells(1, 1).Resize(1, colCount)
.Value = sht.Cells(1, 1).Resize(1, colCount).Value
'Set font as bold
.Font.Bold = True
EndWith

'We can start loop
For Each sht In wrk.Worksheets
'If worksheet in loop is the last one, stop execution (it is Master worksheet)
If sht.Index = wrk.Worksheets.Count Then
Exit For
End If
'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
'Put data into the Master worksheet
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Next sht
'Fit the columns in Master worksheet
trg.Columns.AutoFit

'Screen updating should be activated
Application.ScreenUpdating = True
EndSub

MINCUS1308
11-08-2017, 11:46 AM
There are a couple of syntax errors in the code that was posted.
Just to make sure - try running this corrected code:


Sub CopyFromWorksheets()
Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim trg As Worksheet 'Master Worksheet
Dim rng As Range 'Range object
Dim colCount As Integer 'Column count in tables in the worksheets

Set wrk = ActiveWorkbook 'Working in active workbook

For Each sht In wrk.Worksheets
If sht.Name = "Master" Then
MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
"Please remove or rename this worksheet since 'Master' would be" & _
"the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
Exit Sub
End If
Next sht
'We don't want screen updating
Application.ScreenUpdating = False
'Add new worksheet as the last worksheet
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))

'Rename the new worksheet
trg.Name = "Master"

'Get column headers from the first worksheet
'Column count first
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(1, 255).End(xlToLeft).Column

'Now retrieve headers, no copy&paste needed
With trg.Cells(1, 1).Resize(1, colCount)
.Value = sht.Cells(1, 1).Resize(1, colCount).Value
.Font.Bold = True
End With
'We can start loop
For Each sht In wrk.Worksheets
'If worksheet in loop is the last one, stop execution (it is Master worksheet)
If sht.Index = wrk.Worksheets.Count Then
Exit For
End If

'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))

'Put data into the Master worksheet
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Next sht
'Fit the columns in Master worksheet
trg.Columns.AutoFit
'Screen updating should be activated
Application.ScreenUpdating = True
End Sub

MINCUS1308
11-08-2017, 12:08 PM
I made a few modifications to the code that you posted but in large I did not do anything.
This code ran as the in-code descriptions stated. If it is not doing what you are looking for I can help you make the required changes.


Sub CopyFromWorksheets()
Application.ScreenUpdating = False

Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim trg As Worksheet 'Master Worksheet
Dim rng As Range 'Range object
Dim colCount As Integer 'Column count in tables in the worksheets

'CHECK THE WORKBOOK FOR SHEET NAMED 'Master'
Set wrk = ActiveWorkbook 'Working in active workbook
For Each sht In wrk.Worksheets
If sht.Name = "Master" Then
MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
"Please remove or rename this worksheet since 'Master' would be" & _
"the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
Exit Sub
End If
Next sht

'CREATE 'Master' WORKSHEET
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
trg.Name = "Master"

'COUNT COLUMNS IN THE FIRST SHEET
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(1, 255).End(xlToLeft).Column '<<<FYI - THIS IS PRONE TO ERRORS
'"COPY" AND BOLD FIRST ROW OF INFORMATION FROM FIRST SHEET TO THE 'Master' SHEET
With trg.Cells(1, 1).Resize(1, colCount)
.Value = sht.Cells(1, 1).Resize(1, colCount).Value
.Font.Bold = True
End With
'LOOP THROUGH ALL WORKSHEETS IN THIS WORKBOOK
For Each sht In wrk.Worksheets
'SKIP 'Master' WORKSHEET
If sht.Index = wrk.Worksheets.Count Then Exit For
'SET RANGE FROM ROW 2 TO THE "LAST" ROW FOR ALL COLUMNS < colCount
'FYI - THIS ASSUMES THAT THE HEADERS ARE THE SAME IN EVERY WORKSHEET

Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
'MOVE DATA FROM THE ACTIVESHEET TO THE 'Master' SHEET
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Next sht

'AUTO FIT COLUMNS IN 'Master' SHEET
trg.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

MINCUS1308
11-08-2017, 12:24 PM
Attached is an example workbook:

20894

Dutchyb
11-08-2017, 12:32 PM
Thank you for the very fast reply.

The problem still exists. I added two screenshot to show you the 2nd sheet and the end of the master sheet.

The header of 2nd sheet is copied and only row 2

Dutchyb
20896

20897

MINCUS1308
11-08-2017, 12:54 PM
I cant really dive into the problem with screen shots.
is your row 1 hidden by chance?
the lack of data in column 1 might also be the culprit.
put some dummy data into column 1 and try to run it again.

if you could post the actual workbook it would make trouble shooting a lot easier.

the code that i posted is the same that is in my uploaded example file.
the dummy data i used worked.

MINCUS1308
11-08-2017, 01:01 PM
I was wrong. I am not able to produce the same error. i believe this has something to do with your actual first row

MINCUS1308
11-08-2017, 01:05 PM
Id need the workbook or one with empty data to figure out what is wrong

Dutchyb
11-08-2017, 01:20 PM
Hi Mincus1308,


there is indeed one column that is not filled with data in every row. In the beginning not every column was filled.
Will try to explain.
It is a mailing list. The first one wil be guests of 2017. The second sheet is 2018. As I want to send all guests newsletter I need to upload all data as a CSV file to the ESP. That is the reason I want one sheet with all the guests details.

Hope this make sense:)

mdmackillop
11-09-2017, 04:16 AM
Hi Dutchb

I don't know if it is allowed but here is the code:
Definitely allowed. It is advantageous to post sample workbooks containing the code and data for testing purposes (Go Advanced / Manage Attachments)
Also; please use a more descriptive title (as edited); most issues here are "VBA Problem". Use the # button or code tags to format code as shown.

Dutchyb
11-09-2017, 05:00 AM
Thank you for the "tutorial". Will definitely do as you suggested.

Thanks
Dutchyb

MINCUS1308
11-09-2017, 06:10 AM
Couldn't you simply copy and paste the data manually?
Furthermore, this method will potentially lead to duplicated data - no one likes spam mail.
I cant really do anything without the workbook - the code runs, and works.
There's something else going on.

Dutchyb
11-09-2017, 07:06 AM
Thank you for the reply.

I checked the second sheet (2018) what I found is that when all columns are filled the code is working perfect. So I think it has something to do with empty cells.

May I ask another question , is it possible to add the date of today after the text Master in the created master sheet?

Thanks for your time.
Dutchyb

MINCUS1308
11-09-2017, 08:33 AM
I would suggest making column "A" a 'key' - some sort of unique identifier or just something.
the .end(xlup) statements are prone to errors like you are experiencing.

Yes but you need to make 2 changes.

1st
When you check for the 'Master' worksheet:

If sht.Name = "Master" Then
needs to be:

If sht.Name = ("Master " & Format(Date, "mm-dd-yyyy")) Then

2nd
When you name the new 'Master' worksheet:

trg.Name = "Master"
needs to be:

trg.Name ="Master " & Format(Date, "mm-dd-yyyy")

Dutchyb
11-09-2017, 09:06 AM
Hi Mark,

This is wonderful. It is working smoothly. Changed the name of the sheet and added the date. Thank you so much.
And regarding the "duplicates", I use a few conditional formats to highlight duplicates based on lastname, date of birth and email address.

Thank you once again,
Dutchyb

MINCUS1308
11-09-2017, 09:15 AM
Glad I could help.

if you're all set could you mark this thread as solved?
in the top right corner of the thread there is a thread tools drop down.
in that list is a 'mark as solved' option.
that just helps us know which ones still need help.

on a side note. not to over complicate things but VBA could also identify duplicates for you during the transfer process

Dutchyb
11-09-2017, 12:36 PM
Thank you for the reply and advise. Will close this thread.

Do I have to open a new thread if I need advice on ht duplicate matter as I don't have a clue about VBA.

Thanks
Dutchyb

MINCUS1308
11-09-2017, 12:52 PM
I would. The grand masters typically jump on the new threads pretty fast and typically their solutions are astonishing.

mdmackillop
11-10-2017, 05:26 AM
Do I have to open a new thread if I need advice on ht duplicate matter
Yes. It is better to keep threads "single topic" You can include a link to posts in this thread if you think it helpful.