Question

我最初收到了很多帮助，但是我在路上遇到了另一个问题。下面的代码复制了我需要的所有东西但是贴错了。我需要以下代码才能工作但我想添加我只希望列K粘贴值。其他列具有我需要的格式。任何想法??

Sub getScheduleCurrentMonth()
Dim celltxt As String
Dim N As Long
Dim r As Integer

'get the current month orders

With Workbooks("Workbook1.xlsm").Worksheets("Sheet1")

    Dim foundIt As Range
    Set foundIt = .Range("B1:B1000").Find("CURRENT MONTH", LookAt:=xlWhole)

    If Not foundIt Is Nothing Then

    Set foundIt = .Range(foundIt.Offset(1, -1), foundIt.End(xlDown)) 'from column A and down
    Set foundIt = foundIt.Resize(foundIt.rows.Count, 30) 'from column A to AD
    foundIt.Copy

    Workbooks("AutomationTest.xlsm").Worksheets("Fast Track").Cells(rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial 'xlPasteValues
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

    Else
        MsgBox ("No data for Current Month Found")

    End If

End With

Answer 1

我尽量避免使用.Copy / .Paste。

查看以下内容是否适合您：

Sub getScheduleCurrentMonth()

    Dim celltxt As String, N As Long, r As Long
    Dim wsSrc As Worksheet, wsTgt As Worksheet
    Set wsSrc = Workbooks("Workbook1.xlsm").Worksheets("Sheet1")
    Set wsTgt = Workbooks("AutomationTest.xlsm").Worksheets("Fast Track")

    'get the current month orders
    Dim foundIt As Range, copyRng As Range, pasteRng As Range

    With wsTgt
        r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    End With

    Set foundIt = wsSrc.Range("B1:B1000").Find("CURRENT MONTH", LookAt:=xlWhole)

    If Not foundIt Is Nothing Then

        Set copyRng = wsSrc.Range("A" & foundIt.Row, "AD" & foundIt.Row)
        Set pasteRng = wsTgt.Range("A" & r, "AD" & r)
        pasteRng.Value = copyRng.Value

    Else

        MsgBox ("No data for Current Month Found")

    End If


End Sub

tion.ScreenUpdating = True

    Else

        MsgBox ("No data for Current Month Found")

    End If


End Sub

2部分动态选择

1 个答案: