Question

我有下面的代码将数据从一个表复制到另外三个现有工作表，但我还需要将所选数据列复制到其他工作表作为摘要并附加到现有数据。

表格中有9列，但我只需将其中的4列复制到另一张表格中。第5列保留了用于分割数据的标准，我需要复制第1,2,4和8列。

Sub SplitData()

Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim wsNames As Variant
Dim i As Long
Dim LastRow As Long

Set wsInput = Sheets("Input Sheet")
wsNames = Array("Output 1", "Output 2", "Output 3")
Const FilterColumn = 7

With wsInput
LastRow = wsInput.Range("C" & Rows.Count).End(xlUp).Row

   For i = 0 To UBound(wsNames)
   Set wsOutput = Worksheets(wsNames(i))
   wsOutput.Cells.ClearContents

       With wsInput.Range("C105:K" & LastRow)
       .AutoFilter Field:=FilterColumn, Criteria1:=wsNames(i)
       .Offset(0, 0).Copy wsOutput.Range("A2")
       End With
   Next i

End With

End Sub

非常感谢任何帮助。

我使用下面的代码将同一工作簿中的其他数据复制到另一张工作表中，并且很难找到一种方法将它与需要复制并拆分成多张工作表的数据表相结合。

Sub CopyExpenditure()

Dim wsCopyFrom As Worksheet
Dim wsCopyExpTo As Worksheet

Set wsCopyFrom = Worksheets("Input Sheet")
Set wsCopyExpTo = Worksheets("Cash Expenditure List")

LastRow = wsCopyExpTo.Range("C" & Rows.Count).End(xlUp).Row

wsCopyFrom.Activate
If wsCopyFrom.Range("F59") = 0 Then
Exit Sub
End If

If wsCopyFrom.Range("G59") > 0 Then
    MsgBox ("Row(s) contain a Description but not an amount. Please enter an amount or clear the Description field")
Exit Sub
End If

wsCopyExpTo.Activate
If Range("c" & LastRow) = "Total" Then
Rows(LastRow).EntireRow.Select
Selection.Delete Shift:=xlUp

End If

LastCopyRow = wsCopyFrom.Range("C57").Row

For x = 37 To LastCopyRow
wsCopyFrom.Activate
LastRow2 = wsCopyExpTo.Range("C" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("c37:F57").Select
    chkValue = Cells(x, 6).Value
    If chkValue > 0 Then
    Cells(x, 3).Resize(1, 4).Copy
wsCopyExpTo.Activate
ActiveSheet.Range("C" & LastRow2 + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
Next x

LastRow4 = wsCopyExpTo.Range("A" & Rows.Count).End(xlUp).Row

wsCopyFrom.Activate
ActiveSheet.Range("d7").Select
Selection.Copy
wsCopyExpTo.Activate
ActiveSheet.Range("a" & LastRow4 + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
ActiveSheet.Range("A10:A" & LastRow4 + 1).NumberFormat = "dd/mm/yyyy"

wsCopyFrom.Activate
ActiveSheet.Range("F7").Select
Selection.Copy
wsCopyExpTo.Activate
ActiveSheet.Range("b" & LastRow4 + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False

LastRow3 = wsCopyExpTo.Range("c" & Rows.Count).End(xlUp).Row

wsCopyExpTo.Range("a" & LastRow2 + 1).Select
Range("a" & LastRow4 + 1 & ":a" & LastRow3).FillDown

wsCopyExpTo.Range("b" & LastRow2 + 1).Select
Range("b" & LastRow4 + 1 & ":b" & LastRow3).FillDown


Range("G10:AB10").Select
Range("A10").EntireRow.Hidden = True
Selection.AutoFill Destination:=Range("G10:AB" & LastRow3), Type:=xlFillDefault

wsCopyExpTo.Cells(LastRow3 + 2, 3) = "Total"
wsCopyExpTo.Cells(LastRow3 + 2, 6) = WorksheetFunction.Sum(Range("f11:f" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 7) = WorksheetFunction.Sum(Range("g11:g" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 8) = WorksheetFunction.Sum(Range("h11:h" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 9) = WorksheetFunction.Sum(Range("i11:i" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 10) = WorksheetFunction.Sum(Range("j11:j" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 11) = WorksheetFunction.Sum(Range("k11:k" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 12) = WorksheetFunction.Sum(Range("l11:l" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 13) = WorksheetFunction.Sum(Range("m11:m" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 14) = WorksheetFunction.Sum(Range("n11:n" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 15) = WorksheetFunction.Sum(Range("o11:o" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 16) = WorksheetFunction.Sum(Range("p11:p" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 17) = WorksheetFunction.Sum(Range("q11:q" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 18) = WorksheetFunction.Sum(Range("r11:r" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 19) = WorksheetFunction.Sum(Range("s11:s" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 20) = WorksheetFunction.Sum(Range("t11:t" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 21) = WorksheetFunction.Sum(Range("u11:u" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 22) = WorksheetFunction.Sum(Range("v11:v" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 23) = WorksheetFunction.Sum(Range("w11:w" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 24) = WorksheetFunction.Sum(Range("x11:x" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 25) = WorksheetFunction.Sum(Range("y11:y" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 26) = WorksheetFunction.Sum(Range("z11:z" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 27) = WorksheetFunction.Sum(Range("aa11:aa" & LastRow3))
wsCopyExpTo.Cells(LastRow3 + 2, 28) = WorksheetFunction.Sum(Range("ab11:ab" & LastRow3))

With wsCopyExpTo.Rows(LastRow3 + 2)
    .Font.ColorIndex = 1
    .Font.Bold = True
    .NumberFormat = "_-#,###.00_-;_-(#,###.00);0.00_-"
End With

Range("AB10").EntireColumn.Hidden = True



End Sub

这最好分成两个任务;第一个将数据拆分为三个临时表，第二个任务是将其分成所需的格式？

vba根据条件

0 个答案: