推荐订阅源

Sub Macro1()
    Sheets("Sheet1").Select
    Range("A1").Select
    Selection.Copy
    Sheets("公式").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("D1").Select
    Application.CutCopyMode = False
    Selection.Copy  '拷贝日期
    
    Sheets("ALL").Select
    Call moveEmpty
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ActiveCell.Value
        Selection.Copy
    Call copyData("Service")
    '---------------拷贝数据----
    Call copyImpl("all classes", "ALL")
        End Sub
Sub copyData(sheetName)
    Sheets(sheetName).Select
    Call moveEmpty
    ActiveSheet.Paste
End Sub
Sub copyImpl(strNamespace, sheetName)
    Sheets("Sheet1").Select
    selectRange (strNamespace)
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(sheetName).Select
    ActiveCell.Offset(0, 1).Select
    ActiveSheet.Paste
End Sub
Sub selectRange(stringv)
    Range("A1").Select
    Dim i As Integer
    i = 0
    While (ActiveCell.Value <> stringv)
        ActiveCell.Offset(1, 0).Select
        i = i + 1
        If i > 200 Then
           GoTo ttt
        End If
    Wend
ttt:
    Dim cell
    Set cell = ActiveCell.Cells
        Debug.Print cell.Row
    Debug.Print cell.Column
    Range(cell, Cells(cell.Row, cell.Column + 4)).Select
End Sub
'移动到空行
Sub moveEmpty()
    Dim i As Integer
    i = 2
    Cells(i, 1).Select
    While (ActiveCell.Value <> "")
        i = i + 1
        Cells(i, 1).Select
    Wend
End Sub

用了有一阵子了，希望下次写时，能少查一点vba的资料。

基本上用宏录制，再略改改就帮忙做一些重复工作了。