时间戳

首页 > 解决方案 > Excel 宏循环遍历范围，复制/粘贴（一些复杂性）

excel - Excel 宏循环遍历范围，复制/粘贴（一些复杂性）

问题描述

我在“sheet2”中有一系列数据（C2：C100）。我想分别复制粘贴到工作表“详细 LOC”的单元格 A2，从“详细 LOC”的 (A2:K2) 复制结果，并将（仅值）粘贴到 (A2:K2) 中作为第一个值，（A3 :K3) 工作表“All LOC”的第二个，依此类推。我读过复制/粘贴很密集，但是 sheet2 中单元格 (A1:D1) 中的公式很复杂，我只想要它们在“All LOC”中的结果粘贴中产生的值。我为“sheet2”范围内的第一个单元格记录了我想要它做的宏。我不确定如何集成循环以使其在“sheet2”的整个范围内重复，以及如何让它将结果粘贴到降序行中的“ALL LOC”中。注意发生在“

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

标签： excelvbaloopscopyrange

解决方案

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

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

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

推荐阅读