嗨,大家好,我是星光。
之前咱們分享過一段VBA小代碼,作用是將多個工作表的數(shù)據(jù)匯總成總表,但那段代碼并沒有保留原工作表的格式。在實際工作中,有些朋友是需要保留源表格式的。
以下代碼在將各工作表數(shù)據(jù)匯總的同時,也保留了源表格式。
Sub CollectDataFromShtFormat() Dim sht As Worksheet, rng As Range, k As Long, nTitleCount As Long On Error Resume Next nTitleCount = Val(InputBox('請輸入標題的行數(shù)', '提醒', 1)) If nTitleCount < 0 Then MsgBox '標題行數(shù)不能為負數(shù)。', 64, '提示': Exit Sub Application.ScreenUpdating = False Cells.ClearContents '清空當(dāng)前表數(shù)據(jù) For Each sht In Worksheets '遍歷工作表 If sht.Name <> ActiveSheet.Name Then '如果工作表名稱不等于當(dāng)前表名則進行匯總動作…… Set rng = sht.UsedRange k = k + 1 '累計K值 If k = 1 Then '如果是首個表格,則K為1,則把標題行一起復(fù)制到匯總表 sht.Cells.Copy: Range('a1').PasteSpecial Paste:=xlPasteFormats '只粘貼格式 rng.Copy: Range('a1').PasteSpecial Paste:=xlPasteValues '只粘貼數(shù)值 Else '否則,扣除標題行后再復(fù)制黏貼到總表,只黏貼數(shù)值 rng.Offset(nTitleCount).Copy With Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1) .PasteSpecial Paste:=xlPasteFormats '粘貼格式 .PasteSpecial Paste:=xlPasteValues '粘貼數(shù)值 End With End If End If Next Range('a1').Activate Application.ScreenUpdating = True '恢復(fù)屏幕刷新 MsgBox '匯總OK,一共匯總了:' & k & '張工作表' End Sub
|