Solved VBA codes to merge mutiple into 1 worksheets

September 11, 2016 at 01:50:08
Specs: Windows 7
Hi, I have a dataset with multiple worksheets of the same structure, with the headers appearing in the same row for all worksheets and columns are consistent:
Row 1 consist of main header and row 2 the sub-header. The number of rows in worksheets are not the same.
Example, data for sheet1 starts from cell A3 to E6
Worksheet1:
Date Product Area Sales volume Sales figures
Jan2016 A X 10 30

Jan2016 B Y 15 34
Jan2016 C Z 12 90

Data for sheet2 starts from cell A3 to E7
Worksheet2:
Date	Product	Area	Sales volume	Sales figures
Jan2016	A	X	10	30
Feb2016	B	Y	15	34
Feb2016	B	Z	12	90
Feb2016	C	Z	12	90

Format of the last worksheet is different. It contain the footer at the last row and sum of volume and figures of all records in the 2nd last row.
Last worksheet:

Date	Product	Area	Sales volume	Sales figures
Jan2016	B	Y	15	34
Jan2016	C	Z	12	90
Total			100	2500
Generated by sales office A				

I would like to have the VBA codes to copy column A to E and row 3 to last row from worksheet 1 and paste as values into a new worksheet. To copy and paste as values for all remaining worksheets into this worksheet without the variable names (e.g. Date, ...Sales figures). For the last worksheet, to copy the data but omit the last 2 rows containing the footer at the last row and sum of volume and figures of all records in the 2nd last row.
The final format would be look like the following table:
Date	Product	Area	Sales volume	Sales figures
Jan2016	A	X	10	30
Jan2016	B	Y	15	34
Jan2016	C	Z	12	90
Jan2016	A	X	10	30
Feb2016	B	Y	15	34
Feb2016	B	Z	12	90
Feb2016	C	Z	12	90
Jan2016	B	Y	15	34
Jan2016	C	Z	12	90

Thanks for your help and advice in advance.

message edited by lhm


See More: VBA codes to merge mutiple into 1 worksheets

Reply ↓  Report •


✔ Best Answer
September 20, 2016 at 19:50:24
I added the Paste:=xlValues instruction.

Regarding the use of the macro across multiple workbooks, see the information at the link below. For more info, DAGS personal.xlsm

https://support.office.com/en-us/ar...

Sub Merger()
Dim sht As Long, lastSrcRow As Long, nextDstRw As Long

'Add new Sheet at end of Workbook, copy headers
 Sheets.Add after:=Sheets(Sheets.Count)
 Sheets(1).Rows("1:2").Copy Sheets(Sheets.Count).Range("A1")

'Loop through all Sheets except for the new sheet
  For sht = 1 To Sheets.Count - 1

'Determine last Row with data in each sheet
   lastSrcRw = Sheets(sht).Range("A" & Rows.Count).End(xlUp).Row
     
'Ignore bottom 2 Rows in last original Sheet
     If Sheets(sht).Name = Sheets(Sheets.Count - 1).Name Then
       lastSrcRw = lastSrcRw - 2
     End If
     
'Determine next available Row in new Sheet, Copy and Paste Values
     nextDstRw = Sheets(Sheets.Count).Range("A" & Rows.Count).End(xlUp).Row + 1
     Sheets(sht).Range("A3:A" & lastSrcRw).EntireRow.Copy
     Sheets(Sheets.Count).Range("A" & nextDstRw).PasteSpecial Paste:=xlValues
  Next
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.



#1
September 12, 2016 at 12:09:13
Sub Merger()
Dim sht As Long, lastSrcRow As Long, nextDstRw As Long

'Add new Sheet at end of Workbook
 Sheets.Add after:=Sheets(Sheets.Count)

'Loop through all Sheets except for the new sheet
  For sht = 1 To Sheets.Count - 1

'Determine last Row with data in each sheet
   lastSrcRw = Sheets(sht).Range("A" & Rows.Count).End(xlUp).Row
     
'Ignore bottom 2 Rows in last original Sheet
     If Sheets(sht).Name = Sheets(Sheets.Count - 1).Name Then
       lastSrcRw = lastSrcRw - 2
     End If
     
'Determine next available Row in new Sheet, Copy and Paste data
    nextDstRw = Sheets(Sheets.Count).Range("A" & Rows.Count).End(xlUp).Row + 1
      Range("A3:A" & lastSrcRw).EntireRow.Copy _
        Sheets(Sheets.Count).Range("A" & nextDstRw)
  Next
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Reply ↓  Report •

#2
September 17, 2016 at 13:14:46
Hi,

Thanks for providing the codes. I have tried running the code and it managed to add 1 new Sheet at end of the workbook but it was blank and data from other worksheets are not copied. Would appreciate it if you can help to look into it again.

Thanks.


Reply ↓  Report •

#3
September 17, 2016 at 14:11:11
Try this. I added the instructions to copy the headers to the new sheet.

BTW...you said that you have "sub-headers" in Row 2, but I don't see them in your examples. I assumed that your text is correct and your examples are wrong. Therefore the copying of the data starts in A3.

The code assumes that you have data in Column A. It uses Column A to determine how many rows of data are in each sheet. If you don't have data in Column A, you'll need to tell me which Column contains data all the way down to the bottom of your data set.

Sub Merger()
Dim sht As Long, lastSrcRow As Long, nextDstRw As Long

'Add new Sheet at end of Workbook, copy headers
 Sheets.Add after:=Sheets(Sheets.Count)
 Sheets(1).Rows("1:2").Copy Sheets(Sheets.Count).Range("A1")

'Loop through all Sheets except for the new sheet
  For sht = 1 To Sheets.Count - 1

'Determine last Row with data in each sheet
   lastSrcRw = Sheets(sht).Range("A" & Rows.Count).End(xlUp).Row
     
'Ignore bottom 2 Rows in last original Sheet
     If Sheets(sht).Name = Sheets(Sheets.Count - 1).Name Then
       lastSrcRw = lastSrcRw - 2
     End If
     
'Determine next available Row in new Sheet, Copy and Paste data
    nextDstRw = Sheets(Sheets.Count).Range("A" & Rows.Count).End(xlUp).Row + 1
      Sheets(sht).Range("A3:A" & lastSrcRw).EntireRow.Copy _
        Sheets(Sheets.Count).Range("A" & nextDstRw)
  Next
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Reply ↓  Report •

Related Solutions

#4
September 20, 2016 at 18:29:46
Hi,
Appreciated your effort spent in working out the codes.
The worksheets are copied and pasted in the new worksheet successfully but in their original format instead of values. I would like to have the headers and data to be pasted as values.
Could you please help to look into it again?

Every month, I would receive a set of new files with the above file format. E.g. 2016Jan.xlsx and 2016Feb.xlsx in Feb2016 and 2016Jan.xlsx, 2016Feb.xlsx and Mar2016.xlsx in Mar2016. Currently, I would need to copy the VBA codes into each file to merge the worksheets. May I know if there is any way to save the VBA codes as 1 template and run the various files without replicating the codes in each file every month? Thanks.

message edited by lhm


Reply ↓  Report •

#5
September 20, 2016 at 19:50:24
✔ Best Answer
I added the Paste:=xlValues instruction.

Regarding the use of the macro across multiple workbooks, see the information at the link below. For more info, DAGS personal.xlsm

https://support.office.com/en-us/ar...

Sub Merger()
Dim sht As Long, lastSrcRow As Long, nextDstRw As Long

'Add new Sheet at end of Workbook, copy headers
 Sheets.Add after:=Sheets(Sheets.Count)
 Sheets(1).Rows("1:2").Copy Sheets(Sheets.Count).Range("A1")

'Loop through all Sheets except for the new sheet
  For sht = 1 To Sheets.Count - 1

'Determine last Row with data in each sheet
   lastSrcRw = Sheets(sht).Range("A" & Rows.Count).End(xlUp).Row
     
'Ignore bottom 2 Rows in last original Sheet
     If Sheets(sht).Name = Sheets(Sheets.Count - 1).Name Then
       lastSrcRw = lastSrcRw - 2
     End If
     
'Determine next available Row in new Sheet, Copy and Paste Values
     nextDstRw = Sheets(Sheets.Count).Range("A" & Rows.Count).End(xlUp).Row + 1
     Sheets(sht).Range("A3:A" & lastSrcRw).EntireRow.Copy
     Sheets(Sheets.Count).Range("A" & nextDstRw).PasteSpecial Paste:=xlValues
  Next
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Reply ↓  Report •


Ask Question