obsidian/知识参考/电脑软件常用指令/Excel-VBA/VBA 合并sheet内容合集.md

参考文献	https://www.cnblogs.com/cyf18/archive/2004/01/13/14287227.html

Sub hb()
Dim bt, i, r, c, n, first As Long
bt = 1 '表头行数，多行改为对应数值
Cells.Clear
For i = 1 To Sheets.Count
If Sheets(i).Name <> ActiveSheet.Name Then
If first = 0 Then
c = Sheets(i).Cells(1, Columns.Count).End(xlToLeft).Column
Sheets(i).Range("A1").Resize(bt, c).Copy Range("A1")
n = bt + 1: first = 1
End If
r = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row
Sheets(i).Range("A" & bt + 1).Resize(r - 1, c).Copy Range("A" & n)
n = n + r - bt
End If
Next
End Sub

参考文献	https://blog.csdn.net/wisdom_c_1010/article/details/79003842
个人心得	模糊合并注意like用法

Sub 合并当前工作簿下的所有工作表()

Application.ScreenUpdating = False

For j = 1 To Sheets.Count

If Sheets(j).Name <> ActiveSheet.Name AND Sheets(j).Name Like "CB*" Then

X = Range("A65536").End(xlUp).Row + 1

Sheets(j).UsedRange.Offset(1).Copy Cells(X, 1)

End If

Next

Range("B1").Select

Application.ScreenUpdating = True

MsgBox "当前工作簿下的全部工作表已经合并完毕！", vbInformation, "提示"

End Sub

UsedRange.Offset(1)：目标区域是当前表已用区域整体下移1行后的区域

参考文献	http://club.excelhome.net/thread-1408198-1-1.html
个人心得	指定工作表合并-学习版本

Sub CopyCellData()
Dim RowEnd
Dim SheetName
Dim SheetObj

SheetName = ActiveSheet.Name
RowEnd = ActiveSheet.UsedRange.Rows.Count

For Each SheetObj In Worksheets
If SheetObj.Name <> SheetName Then

RowEnd = SheetObj.UsedRange.Rows.Count
SheetObj.Rows("1:" & RowEnd).Copy RowEnd = Sheets(SheetName).UsedRange.Rows.Count
If RowEnd <> 1 Then
Sheets(SheetName).Range("A" & RowEnd + 1) = SheetObj.Name
Sheets(SheetName).Range("A" & RowEnd + 2).Select
Else
Sheets(SheetName).Range("A" & RowEnd) = SheetObj.Name
Sheets(SheetName).Range("A" & RowEnd + 1).Select
End If
ActiveSheet.Paste
End If
Next SheetObj