Question

我将数据从一个工作簿导出到另一个工作簿T13:Tlastrow 这个数据来自我运行此宏的工作簿中的F列，我希望在第13行（{nyckel="TEXT HERE";}）开始的“新”工作簿的T列中放入T13。

我被困在这里。所以真的很感激一些帮助/解决方案。谢谢！

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循环来自排＆＃39; 13 + i＆＃39;其中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

的整个块

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

2 个答案: