Copy/Paste 根据单个单元格值将项目添加到另一个 sheet

Question

我正在尝试创建一个宏，它根据单个单元格的值 (B2) 将我的 "Backend" 作品sheet 中（A 列）中的 copy/paste 项循环到我的 "Backend 2" 工作 sheet。为了提供一些背景信息，我预测了建筑楼层的数据并尝试重新格式化我的传播 sheet 以便 Tableau 将日期读取为 "dimensions." 为了实现这一点，我需要一个宏 copy/paste 我预测的 15 个月里我的 83 层数据 15 次。我还想要参考单元格 (B2)，以便我可以在需要时为预测添加月份。谢谢！

复制自：

粘贴到：

当前的答案允许我复制一个值类型 "floor," 但我想知道我是否可以运行一个宏，它会 copy/paste 基于复制量的整行。请参考以下例子。我在 sheet 1 上有 3 个独特的团队，我想根据 sheet 2 上的单元格 L2 复制四次。

之前 (Sheet 1)

之后 (Sheet 2)

Answer 1

根据我的测试，措辞代码类似于以下内容。 修改 soucreSheet 和 targetWorksheet 为你的:

Sub Test11()

Dim rowCount As Long
Dim sourceSheet As Worksheet
Dim targetWorksheet As Worksheet
Dim copyTimes As Integer

  Set sourceSheet = Worksheets("Sheet11")
  Set targetWorksheet = Worksheets("Sheet12")
    rowCount = targetWorksheet.Cells(Rows.Count, 1).End(xlUp).row

    copyTimes = CInt(sourceSheet.Cells(2, 2).Value)

    For i = 2 To sourceSheet.UsedRange.Rows.Count
        MsgBox sourceSheet.Cells(i, 1).Value
        sourceSheet.Cells(i, 1).Copy
        For j = 1 To copyTimes
            targetWorksheet.Activate
            targetWorksheet.Cells(rowCount + 1, 1).Select
            targetWorksheet.Paste
            rowCount = rowCount + 1
        Next

            sourceSheet.Activate
    Next

    Application.CutCopyMode = False
End Sub

Answer 2

这应该适合你：

Sub floors()

    Dim ws1 As Worksheet
    Set ws1 = sheets("Bcknd")

    Dim ws2 As Worksheet

    If Not sheetExists("Migration Plan Data Extract") Then
        sheets.Add After:=ws1
        Set ws2 = sheets(ws1.index + 1)
        ws2.name = "Migration Plan Data Extract"
    Else
        Set ws2 = sheets("Migration Plan Data Extract")
    End If

    If Len(ws1.Range("B2").Value2) > 0 And IsNumeric(ws1.Range("B2").Value2) Then
        ws2.Range("A1").Value2 = ws1.Range("A1").Value2

        Dim vals As Variant
        vals = ws1.Range("A2:A" & ws1.Range("A" & Rows.Count).End(xlUp).Row).Value

        Dim i As Long
        Dim j As Long: j = 1

        For i = 1 To ws1.Range("B2").Value2 * UBound(vals)
            ws2.Range("A" & i + 1).Value2 = vals(j, 1)

            If i Mod ws1.Range("B2") = 0 Then
                j = j + 1
            End If
        Next i

    End If

End Sub

好的，这应该复制整行:)

Sub floors2()

    Dim ws1 As Worksheet
    Set ws1 = sheets("Bcknd")

    If Len(ws1.Range("L2")) > 0 And IsNumeric(ws1.Range("L2").Value2) Then

        Dim ws2 As Worksheet

        If Not sheetExists("Migration Plan Data Extract") Then
            sheets.Add After:=ws1
            Set ws2 = sheets(ws1.index + 1)
            ws2.name = "Migration Plan Data Extract"
        Else
            Set ws2 = sheets("Migration Plan Data Extract")
        End If

        ws1.Range("A1:J1").copy Destination:=ws2.Range("A1:J1")

        Dim lastRow As Long
        lastRow = ws1.Range("A" & rows.count).End(xlUp).row

        Dim rng As Range
        Set rng = ws1.Range("A2:J" & lastRow)

        Dim currentRow As Long: currentRow = 2

        Dim i As Long
        Dim j As Long
        For i = 1 To rng.rows.count
            For j = 1 To ws1.Range("L2").Value2
                rng.rows(i).copy Destination:=ws2.Range("A" & currentRow)
                currentRow = currentRow + 1
            Next j
        Next i

    End If

End Sub

这个sub被双方用来查看sheet "Migration Plan Data Extract"是否已经存在

Function sheetExists(sheetToFind As String) As Boolean

    sheetExists = False

    Dim sheet As Worksheet
    For Each sheet In Worksheets
        If sheetToFind = sheet.name Then
            sheetExists = True
            Exit Function
        End If
    Next sheet

End Function

Copy/Paste 根据单个单元格值将项目添加到另一个 sheet

Copy/Paste Item onto another sheet based on a single cell value

vba

excel

excel-2007

copy-paste