-
Notifications
You must be signed in to change notification settings - Fork 0
/
combine_sheets.txt
147 lines (106 loc) · 4.76 KB
/
combine_sheets.txt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
' check if sheet already exists
Function SheetExists(ByVal sheetname As String) As Boolean
Dim sht As Worksheet
On Error Resume Next
Set sht = ActiveWorkbook.Sheets(sheetname)
On Error GoTo 0
SheetExists = Not sht Is Nothing
End Function
Sub combine_multiple_sheets()
Application.ScreenUpdating = False
Dim wb As Workbook: Set wb = Application.ActiveWorkbook
'create combined sheet
Dim sheetname As String
sheetname = "All"
If SheetExists(sheetname) = True Then
res = MsgBox("The combined sheet [ALL] exists, do you want to delet it?", vbYesNo)
If res = vbYes Then
Application.DisplayAlerts = False
wb.Sheets(sheetname).Delete
Application.DisplayAlerts = True
Else
MsgBox ("Exit combine sheet")
Exit Sub
End If
End If
wb.Sheets.Add(Before:=wb.Worksheets(1)).Name = sheetname
' destination sheet
Dim ws_dst As Worksheet
Set ws_dst = Sheets(sheetname)
ws_dst.Select
ws_dst.Cells.Clear
Dim dst_start_col As Long
add_source = MsgBox("Do you want to add [Source Sheet Name] in the first column of combined sheet?", vbYesNo)
If add_source = vbYes Then
dst_start_col = 1
Else
dst_start_col = 0
End If
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
wb.Sheets(ws.Name).Select
' clear the filter and show all data
With ws
If .AutoFilterMode Then .AutoFilter.ShowAllData
.Columns.Hidden = False
.Rows.Hidden = False
.Cells(1, 1).Select
End With
If ws.Name <> sheetname Then
Dim last_row, last_col, dst_last_row As Long
'last_row = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
'last_row = Cells(Rows.Count, 1).End(xlUp).Row
On Error GoTo next_sheet
last_row = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
'last_col = ws.UsedRange.Column + ws.UsedRange.Columns.Count - 1
last_col = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
'header row
For i = 1 To last_col
If add_source = vbYes Then
ws_dst.Cells(1, 1).Value = "Source Sheet Name"
End If
If (Not IsEmpty(ws.Cells(1, i).Value)) And Len(Trim(ws.Cells(1, i).Value)) > 0 Then
ws.Cells(1, i).Copy
ws_dst.Cells(1, i + dst_start_col).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
ws_dst.Cells(1, i + dst_start_col).PasteSpecial Paste:=xlPasteColumnWidths
End If
Next
Dim rng_src, rng_dst As Range
Set rng_scr = ws.Range(ws.Cells(2, 1), ws.Cells(last_row, last_col))
rng_scr.Copy
wb.Sheets(ws_dst.Name).Select
dst_last_row = ws_dst.UsedRange.Rows(ws_dst.UsedRange.Rows.Count).Row
ws_dst.Cells(dst_last_row + 1, 1 + dst_start_col).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
If add_source = vbYes Then
ws_dst.Range(ws_dst.Cells(dst_last_row + 1, 1), ws_dst.Cells(dst_last_row + last_row - 1, 1)).Value = ws.Name
End If
End If
next_sheet:
Next ws
dst_last_row = ws_dst.UsedRange.Rows(ws_dst.UsedRange.Rows.Count).Row
ws_dst.Select
ws_dst.Range("A1").AutoFilter
If add_source = vbYes Then
ws_dst.Range("A1:A" & dst_last_row).Borders.LineStyle = xlContinuous
ws_dst.Columns("A").EntireColumn.ColumnWidth = 15
End If
ws_dst.Columns("E").EntireColumn.ColumnWidth = 15
ws_dst.Columns("M:V").EntireColumn.ColumnWidth = 15
ws_dst.Rows("2:" & dst_last_row).RowHeight = 50
ws_dst.Range("A1").Select
MsgBox "sheets combined to Sheet [All]"
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub