Sub 工作薄间工作表合并()
'Dim FileOpen
'Dim X As Integer
'Application.ScreenUpdating = False
'FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel文件(*.xls),*.xls", 'MultiSelect:=True, Title:="合并工作薄")
'X = 1
'While X <= UBound(FileOpen)
'Workbooks.Open Filename:=FileOpen(X)
'Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'X = X + 1
'Wend
'ExitHandler:
'Application.ScreenUpdating = True
'Exit Sub
'
'errhadler:
'MsgBox Err.Description
Application.DisplayAlerts = False
Application.ScreenUpdating = False
FileToOpen_N = Application.GetOpenFilename("xlsx文件,*.xlsx", Title:="请选择要合并工作簿:", MultiSelect:=True)
Newbz = 0
On Error Resume Next
For Each FileToOpen In FileToOpen_N
If FileToOpen <> False Then
If Newbz = 0 Then
Booknum = Application.SheetsInNewWorkbook
Application.SheetInNewWorkbook = 1
Workbooks.Add
Application.SheetsInNewWorkbook = Booknum
NewBookName = ActiveWorkbook.Name
Sheets(1).Name = "sheet_tmp"
Newbz = 1
End If
Set OpenBook = Workbooks.Open(FileToOpen)
For Each Xlsheet In OpenBook.Sheets
Xlsheet.Copy Before:=Workbooks(NewBookName).Sheets("sheet_tmp")
Next
OpenBook.Close SaveChanges:=False
End If
Next
Workbooks(NewBookName).Sheets("sheet_tmp").Delete
Application.ScreenUpadating = True
Application.DisplayAlerts = True
End Sub
Sub 多张表格中输入对应的订单号()
Application.ScreenUpdating = False
'With ActiveSheet
' For i = 27 To 200
' If .Cells(i, 10) <> "" Then
' .Cells(i, 14) = Range("L10").Value
' Else
' .Cells(i, 14) = ""
' End If
' Next
'End With
'
'For j = 1 To Sheets.Count
'If Sheets(j).Name <> ActiveSheet.Name Then
' For i = 27 To 200
' If Cells(i, 10) <> "" Then
' Sheets(j).Select
' Cells(i, 14) = Range("L10").Value
' Else
' Cells(i, 14) = ""
' End If
' Next i
'End If
'Next j
With ActiveSheet
For i = 7 To 6000
If .Cells(i, 2) <> "" Then
.Cells(i, 20) = Range("F3").Value
Else
.Cells(i, 20) = ""
End If
Next
End With
For j = 1 To Sheets.Count
If Sheets(j).Name <> ActiveSheet.Name Then
For i = 7 To 6000
If Cells(i, 2) <> "" Then
Sheets(j).Select
Cells(i, 20) = Range("F3").Value
Else
Cells(i, 20) = ""
End If
Next i
End If
Next j
MsgBox "订单号已经更新完毕！", vbInformation, "提示"
Application.ScreenUpdating = True
End Sub
Sub 合并当前工作簿下的所有工作表()
Application.ScreenUpdating = False
For J=1 To Sheets.Count
If Sheets(j).Name <> ActiveSheet.Name Then
X=Range("A65535").End(xlUp).Row + 1
Sheets(j).UsedRange.Copy Cells(X,1)
End If
Next
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "当前工作簿下的全部工作簿已经合并完毕", vbInformation, "提示"
End Sub
