Question

我在“ sheet2”中有一系列数据（C2：C100）。我想分别复制粘贴到工作表“ Detailed LOC”的单元格A2中，从“ Detailed LOC”的（A2：K2）复制结果，并将（仅值）粘贴到第一个值（A3：K2）中：K3），以此类推，以此类推），然后进入工作表“ All LOC”。我已经读到复制/粘贴是密集型的，但是sheet2中单元格（A1：D1）中的公式很复杂，我只想要它们在“所有LOC”中的粘贴结果中产生的值。我为“ sheet2”范围内的第一个单元格记录了我想要的宏。我不确定如何集成循环以使其在“ sheet2”的整个范围内重复，以及如何将结果粘贴到降行的“ ALL LOC”中。请注意，“ ALL LOC”中发生的步骤始终出现在第二行（A2：K2）中，而不是下降行中。感谢您的帮助/咨询。

Range("C2").Select
Selection.Copy
Sheets("Detailed LOC").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("A2:K2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("All Loc").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Sheet2").Select
Range("A1").Select

Answer 1

请尝试一下并自定义代码以满足您的需求。

在尝试之前备份您的工作簿！

Sub CopyRanges()

    ' Declare objects
    Dim sourceRange As Range
    Dim detailedRange As Range
    Dim sourceCell As Range

    ' Declare other variables
    Dim sourceSheetName As String
    Dim detailedSheetName As String
    Dim allSheetName As String
    Dim sourceRangeAddress As String
    Dim counter As Integer ' Change for long if more than 32.000 items

    ' Initialize variables
    sourceSheetName = "Sheet2"
    detailedSheetName = "Detailed LOC"
    allSheetName = "All LOC"

    ' Define the address of the source range
    sourceRangeAddress = "C2:C100"

    ' Initialize the source range
    Set sourceRange = ThisWorkbook.Worksheets(sourceSheetName).Range(sourceRangeAddress)

    counter = 1

    ' Loop through each cell in source range
    For Each sourceCell In sourceRange

        ' Copy to detailed sheet (no selection - copy - paste!) - Change the column "A" if needed
        ThisWorkbook.Worksheets(detailedSheetName).Range("A" & sourceCell.Row).Value = sourceCell.Value

        ' Copy to all sheet (if you have formulas, this pastes the values. As you didn't mention, please confirm)  - Change the column "A and K" if needed
        ThisWorkbook.Worksheets(allSheetName).Range("A" & sourceCell.Row & ":" & "K" & sourceCell.Row).Value = ThisWorkbook.Worksheets(detailedSheetName).Range("A" & sourceCell.Row & ":" & "K" & sourceCell.Row).Value

        counter = counter + 1

    Next

    MsgBox "processed " & counter & " cells"

End Sub

Excel宏循环遍历，复制/粘贴（有些复杂）

1 个答案: