Question

试图找到一种简化的方式来完成以下代码...

将两个单独的工作表上几个不同单元格的单元格值复制并粘贴到另一工作表到下一个可用行...

代码的第二部分效果很好...一旦建立了行，并且RW变量标识了行号，它将进行更新。

问题是初始副本粘贴。该代码有效，但运行速度非常非常慢。寻找另一种方法来完成将更快，更清洁地运行的同一件事。

    Private Sub CommandButton1_Click()
    Dim response As Integer
    Dim lkup As String
    Dim SourceWS    As Worksheet, DestWS As Worksheet
    Dim SourceRng   As Range, DestCell   As Range
    Dim lloop As Long
    Set SourceWS = Sheets("Leave Calculations") ' Source Sheet
    Set DestWS = Sheets("Historical") 'Destination Sheet
    lkup = Sheets("Formulas").Range("V5").Value


response = MsgBox("Are you ready to print?", vbYesNo, "PRINT SHEET?")

If response = 6 Then

Application.Dialogs(xlDialogPrinterSetup).Show

ActiveSheet.PrintOut

On Error Resume Next
With Sheets("historical")
    Dim Rw2 As Long, Fnd2 As Range
Set Fnd2 = .Range("B:B").Find(lkup, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlPrevious)
 If Not Fnd2 Is Nothing Then
     Rw2 = Fnd2.Row
 'Else
     'MsgBox lkup & " not found in Historical Data"
 End If
             If Rw2 = 0 Then


        ' Copy data to Historical form


        Application.ScreenUpdating = 0


            With SourceWS
            Set DestCell = DestWS.Range("a" & Rows.Count).End(xlUp).Offset(1)
            For lloop = 1 To 30 ' number must match total cells in range
                Set SourceRng = Choose(lloop, Sheets("Formulas").Range("v4"), Sheets("Formulas").Range("v5"), Sheets("Formulas").Range("v2"), Sheets("Leave Calculations").Range("b6"), _
                Sheets("Leave Calculations").Range("c6"), Sheets("Leave Calculations").Range("d6"), Sheets("Leave Calculations").Range("d11"), Sheets("Formulas").Range("v3"), _
                Sheets("Leave Calculations").Range("e15"), Sheets("Leave Calculations").Range("e16"), Sheets("Leave Calculations").Range("e21"), _
                Sheets("Formulas").Range("b39"), Sheets("Formulas").Range("b57"), Sheets("Formulas").Range("c57"), Sheets("Formulas").Range("V10"), _
                Sheets("Formulas").Range("B1"), Sheets("Formulas").Range("B9"), Sheets("Formulas").Range("B10"), Sheets("Formulas").Range("V22"), _
                Sheets("Formulas").Range("V15"), Sheets("Formulas").Range("V16"), Sheets("Formulas").Range("V17"), Sheets("Formulas").Range("V18"), _
                Sheets("Formulas").Range("V19"), Sheets("Formulas").Range("A2"), Sheets("Formulas").Range("V20"), Sheets("Formulas").Range("A2"), Sheets("Formulas").Range("A2"), _
                Sheets("Formulas").Range("B58"), Sheets("Formulas").Range("v21"), Sheets("Formulas").Range("A2"), Sheets("Formulas").Range("v23")) 'adjust the range
                SourceRng.Copy
                DestCell.Offset(, lloop - 1).PasteSpecial xlPasteValues
            Next lloop
            End With

                With Application
                    .CutCopyMode = 0
                    .ScreenUpdating = 0
                End With
     Else:

Answer 1

代替逐个粘贴单元格，您可以将数组中的所有值收集起来，然后在完成输入范围的循环后将其赋值。

Const NUM_VALS as Long  = 30

dim vals() '<< array for your data

With SourceWS
        Set DestCell = DestWS.Range("a" & Rows.Count).End(xlUp).Offset(1)
        Redim vals(1 to 1, 1 to NUM_VALS)

        For lloop = 1 To NUM_VALS  ' number must match total cells in range

            Set SourceRng = Choose(lloop, Sheets("Formulas").Range("v4"), Sheets("Formulas").Range("v5"), Sheets("Formulas").Range("v2"), Sheets("Leave Calculations").Range("b6"), _
            Sheets("Leave Calculations").Range("c6"), Sheets("Leave Calculations").Range("d6"), Sheets("Leave Calculations").Range("d11"), Sheets("Formulas").Range("v3"), _
            Sheets("Leave Calculations").Range("e15"), Sheets("Leave Calculations").Range("e16"), Sheets("Leave Calculations").Range("e21"), _
            Sheets("Formulas").Range("b39"), Sheets("Formulas").Range("b57"), Sheets("Formulas").Range("c57"), Sheets("Formulas").Range("V10"), _
            Sheets("Formulas").Range("B1"), Sheets("Formulas").Range("B9"), Sheets("Formulas").Range("B10"), Sheets("Formulas").Range("V22"), _
            Sheets("Formulas").Range("V15"), Sheets("Formulas").Range("V16"), Sheets("Formulas").Range("V17"), Sheets("Formulas").Range("V18"), _
            Sheets("Formulas").Range("V19"), Sheets("Formulas").Range("A2"), Sheets("Formulas").Range("V20"), Sheets("Formulas").Range("A2"), Sheets("Formulas").Range("A2"), _
            Sheets("Formulas").Range("B58"), Sheets("Formulas").Range("v21"), Sheets("Formulas").Range("A2"), Sheets("Formulas").Range("v23")) 'adjust the range

            vals(1, lloop) = SourceRng.Value '<< add value to array


        Next lloop
        DestCell.Resize(1, NUM_VALS).Value = vals '<< assign the array
 End With

还可以考虑为工作表创建一些变量，以避免所有重复。

将值从多张纸复制到一张纸

1 个答案: