Merge all worksheets using VBA

Merge all worksheets using VBA

Sub ADO联合查询（）

Dim cnn As Object, SQL$, MyPath$, MyFile$, m&, n&

Set cnn = CreateObject(＂ADODB.Connection＂)

[a:b].ClearContents

MyPath = ThisWorkbook.Path & ＂\＂

MyFile = Dir(MyPath & ＂*.xls＂)

Do While MyFile ＂＂

If MyFile ThisWorkbook.Name Then

n = n 1

If n = 1 Then cnn.Open ＂Provider=Microsoft.Jet.OLEDB.4.0;Extended;Data Source=＂ & MyPath & MyFile

m = m 1

If m >49 Then

Range(＂a＂ & Rows.Count).End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(SQL)

m = 1

SQL = ＂＂

End If

If Len(SQL) Then SQL = SQL & ＂ union all ＂

SQL = SQL & ＂select f1,'＂ & Replace(MyFile, ＂.xls＂, ＂＂) & ＂' from [Excel 8.0;hdr=no;Database=＂ & MyPath & MyFile & ＂].[Sheet1$A2:A]＂

End If

MyFile = Dir()

Loop

If Len(SQL) Then Range(＂a＂ & Rows.Count).End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(SQL)

cnn.Close

Set cnn = Nothing

End Sub

用vba插入合并填充单元格

Private Sub CommandButton1_Click()

'最后一行r，上面插入一行，横向合并单元格n格，填充数据s

Dim n, s, col, r, tmp

'----设定----

n = 2 '横向合并单元格n格

s = ＂XXXXXX＂ '填充数据s

col = ＂A＂ '以col列为操作的最左列

'----执行----

With ActiveSheet

r = .Cells(65536, col).End(xlUp).Row

.Rows(r).Insert xlShiftDown '插入行

With .Cells(r, col).Resize(1, n)

.Merge '合并单元格

.Value = s '填充数据

End With

End With

End Sub

The above is the detailed content of Merge all worksheets using VBA. For more information, please follow other related articles on the PHP Chinese website!