将数据复制到新工作簿并将特定文本添加到特定列中每一行的值

Question

我正在将数据从一个工作簿导出到另一个工作簿 T13:Tlastrow
此数据来自我的工作簿中的 F 列，其中我运行这个宏，我想将其放入 "new" 工作簿的 T 列的 {nyckel="TEXT HERE";} 中，从第 13 行开始（T13).

我被困在这里了。所以真的很感激一些 help/solution。谢谢！

Sub CopyData()
    Dim wkbCurrent As Workbook, wkbNew As Workbook
    Set wkbCurrent = ActiveWorkbook
    Dim valg, c, LastCell As Range
    Set valg = Selection
    Dim wkbPath, wkbFileName, lastrow As String
    Dim LastRowInput As Long
    Dim lrow, rwCount, lastrow2, LastRowInput2 As Long

    Application.ScreenUpdating = False

    ' If nothing is selected in column A
    If Selection.Columns(1).Column = 1 Then

        wkbPath = ActiveWorkbook.Path & "\"
        wkbFileName = Dir(wkbPath & "CIF LISTEN.xlsm")

        Set wkbNew = Workbooks.Open(wkbPath & "CIF LISTEN.xlsm")

        'Application.Run ("'C:\Users\niclas.madsen\Desktop\TEST\CIF LISTEN.xlsm'!DelLastRowData")
        LastRowInput = Cells(Rows.count, "A").End(xlDown).Row

        For Each c In valg.Cells
            lrow = wkbNew.Worksheets(1).Range("B1").Offset(wkbNew.Worksheets(1).Rows.count - 1, 0).End(xlUp).Row + 1

            lastrow2 = Range("A" & Rows.count).End(xlUp).Row
            lastrow3 = Range("T" & Rows.count).End(xlUp).Row

            wkbCurrent.ActiveSheet.Range("E" & c.Row).Copy Destination:=wkbNew.Worksheets(1).Range("A" & lrow)
            wkbCurrent.ActiveSheet.Range("A" & c.Row).Copy Destination:=wkbNew.Worksheets(1).Range("B" & lrow)
            wkbCurrent.ActiveSheet.Range("F" & c.Row).Copy Destination:=wkbNew.Worksheets(1).Range("T" & lrow)
            ' Standard inputs
            wkbNew.Worksheets(1).Range("D13:D" & lastrow2).Value = "Ange referens och period"
            wkbNew.Worksheets(1).Range("E13:E" & lastrow2).Value = "99999002"
            wkbNew.Worksheets(1).Range("G13:G" & lastrow2).Value = "EA"
            wkbNew.Worksheets(1).Range("H13:H" & lastrow2).Value = "2"
            wkbNew.Worksheets(1).Range("M13:M" & lastrow2).Value = "SEK"
            wkbNew.Worksheets(1).Range("N13:N" & lastrow2).Value = "sv_SE"
            wkbNew.Worksheets(1).Range("P13:P" & lastrow2).Value = "TRUE"
            wkbNew.Worksheets(1).Range("Q13:Q" & lastrow2).Value = "TRUE"
            wkbNew.Worksheets(1).Range("S13:S" & lastrow2).Value = "Catalog_extensions"

            'wkbNew.Worksheets(1).Range("T" & lastrow3).Value = "{Nyckelord=" & wkbNew.Worksheets(1).Range("T" & lastrow3).Value & ";}"
        Next
    ' Trying to get this to work
        LastRowInput2 = wkbNew.Worksheets(1).Range("T" & wkbNew.Sheets("Sheet1").UsedRange.Rows.count + 1).End(xlUp).Row

        For i = 0 To LastRowInput2 - 13

            wkbNew.Worksheets(1).Range("T" & 13 + i).Value = "{Nyckelord=" & wkbNew.Worksheets(1).Range("T" & 13 + i).Value & ";}"
        Next i
' END HERE

        ' wkbNew.Close False
        ' Find the number of rows that is copied over
        wkbCurrent.ActiveSheet.Activate
        areaCount = Selection.Areas.count
        If areaCount <= 1 Then
             MsgBox "The selection contains " & Selection.Rows.count & " suppliers."
             ' Write it in A10 in CIF LISTEN
             wkbNew.Worksheets(1).Range("A10").Value = "COMMENTS: " & Selection.Rows.count & " Suppliers Added"
        Else
            i = 1
            For Each A In Selection.Areas
                'MsgBox "Area " & I & " of the selection contains " & _
                    a.Rows.count & " rows."
                i = i + 1
                rwCount = rwCount + A.Rows.count
            Next A
            MsgBox "The selection contains " & rwCount & " suppliers."
            ' Write it in A10 in CIF LISTEN
            wkbNew.Worksheets(1).Range("A10").Value = "COMMENTS: " & rwCount & " Suppliers Added"
        End If

        wkbNew.Worksheets(1).Activate

        Application.ScreenUpdating = True

    Else
        MsgBox "Please select cell(s) in column A", vbCritical, "Error"
        Exit Sub
    End If
End Sub

Answer 1

如果代码在错误的单元格上执行正确的操作，那么问题出在 For 循环的开始和结束处。您的 For 循环从行 '13 + i' 开始，其中 i = 0（即第 13 行），到第 13 行 + LastRowInput2 - 13（即 LastRowInput2）。这对我来说似乎是正确的，所以问题一定出在 LastRowInput2 中的值。

您需要更正此行：

LastRowInput2 = wkbNew.Worksheets(1).Range("T" & wkbNew.Sheets("Sheet1").UsedRange.Rows.count + 1).End(xlUp).Row

这就是为您提供数据中正确的最后一行输入。根据中间是否有空白单元格和其他因素，有几种方法可以找到数据的结尾。这可能是一种选择：

LastRowInput2 = wkbNew.Worksheets(1).Range("T65000").End(xlUp).Row

一定要单步执行代码并验证 LastRowInput2 是否设置为您期望的值，然后这应该可以工作。

Answer 2

确定试试

wkbNew.Worksheets(1).Range("T" & lrow).Value = "{Nyckelord=" &  wkbCurrent.ActiveSheet.Range("F" & c.Row).Value & "}"

代替你的台词：

wkbCurrent.ActiveSheet.Range("F" & c.Row).Copy Destination:=wkbNew.Worksheets(1).Range("T" & lrow)

并删除标记为 'Trying to get this to work

的整个块

将数据复制到新工作簿并将特定文本添加到特定列中每一行的值

Copy data to new workbook and add specific text to each row´s value in a specific column

excel

vba

copy