Question

我正在尝试将一系列数据从一个工作表“A”复制到另一个“B”我的代码是复制单元格正在复制“A”中的一些数据并将其粘贴在“A”中....我不确定这个问题是什么......

    Sub findazuredataandcopyit()

Dim WBB As Excel.Workbook
Dim WBA As Excel.Workbook
Dim Ed As Excel.Worksheet


Set WBB = Workbooks("Source.xlsx")
Set WBA = Workbooks("MODEL.xlsb")


Dim Col As Long, LastRow As Long
Dim Rngm As Range
Dim RngSku As Range
Dim RngPO As Range
If Application.CountIf(WBB.Sheets("B").Rows(1), "plan_tamaward*") > 0 Then
    Col = Application.Match("plan_tamaward*", WBB.Sheets("B").Rows(1), 0)
    LastRow = WBB.Sheets("B").Cells.Find(what:="*", searchdirection:=xlPrevious, searchorder:=xlByRows).Row
    Set Rngm = Range(Cells(2, Col), Cells(LastRow, Col))
Else
    MsgBox "The column named like plan_tamaward* was not found in Row1.", vbExclamation, "Column Not Found!"
    Exit Sub
End If

'set range for sku

If Application.CountIf(WBB.Sheets("B").Rows(1), "plan_sku_*") > 0 Then
    Col = Application.Match("plan_sku_*", WBB.Sheets("B").Rows(1), 0)
    LastRow = WBB.Sheets("B").Cells.Find(what:="*", searchdirection:=xlPrevious, searchorder:=xlByRows).Row
    Set RngSku = Range(Cells(2, Col), Cells(LastRow, Col))

Else
    MsgBox "The column named like plan_sku* was not found in Row1.", vbExclamation, "Column Not Found!"
    Exit Sub
End If

' set range for PO

If Application.CountIf(WBB.Sheets("B").Rows(1), "plan_sku_*") > 0 Then
    Col = Application.Match("Rack PO #*", WBB.Sheets("B").Rows(1), 0)
    LastRow = WBB.Sheets("B").Cells.Find(what:="*", searchdirection:=xlPrevious, searchorder:=xlByRows).Row
    Set RngPO = Range(Cells(2, Col), Cells(LastRow, Col))
    'do whatever you want to do with this range here
Else
    MsgBox "The column named like Rack PO #* was not found in Row1.", vbExclamation, "Column Not Found!"
    Exit Sub
End If

     MsgBox "the range is" & Rngm.Address
      MsgBox "the range is" & RngSku.Address
       MsgBox "the range is" & RngPO.Address

    WBA.Sheets("Sourcesheet").Range("F4").Resize(Rngm.Rows.Count).Value = Rngm.Value
    WBA.Sheets("Sourcesheet").Range("E4").Resize(RngSku.Rows.Count, 1).Value = RngSku.Value
    WBA.Sheets("Sourcesheet").Range("C4").Resize(RngPO.Rows.Count).Value = RngPO.Value

MsgBox "the range is" & Rngm.Address
      MsgBox "the range is" & RngSku.Address
       MsgBox "the range is" & RngPO.Address
End Sub

代码似乎运行完美（找到正确的列，分配变量，并显示正确的范围）问题似乎在于这三行：

WBA.Sheets("Sourcesheet").Range("C4").Resize(RngPO.Rows.Count).Value = RngPO.Value

感谢您的帮助。

Answer 1

您没有在您的陈述中限定您所指的工作表，例如

Set Rngm = Range(Cells(2, Col), Cells(LastRow, Col))

因此，这些语句将范围设置为ActiveSheet上的内容。

您应该完全符合Range和Cells：

的资格

Set Rngm = WBB.Sheets("B").Range(WBB.Sheets("B").Cells(2, Col), WBB.Sheets("B").Cells(LastRow, Col))

重写后的代码最终会看起来像：

Sub findazuredataandcopyit()

    Dim WBB As Excel.Workbook
    Dim WBA As Excel.Workbook
    Dim Ed As Excel.Worksheet

    Set WBB = Workbooks("Source.xlsx")
    Set WBA = Workbooks("MODEL.xlsb")

    Dim Col As Long, LastRow As Long
    Dim Rngm As Range
    Dim RngSku As Range
    Dim RngPO As Range

    'Use a With block to save typing 'WBB.Worksheets("B").' over and over
    With WBB.Worksheets("B")
        'Set LastRow once - no need to do it each time a range needs to be set
        LastRow = .Cells.Find(What:="*", _
                              SearchDirection:=xlPrevious, _
                              SearchOrder:=xlByRows).Row

        If Application.CountIf(.Rows(1), "plan_tamaward*") > 0 Then
            Col = Application.Match("plan_tamaward*", .Rows(1), 0)
            'Fully qualify `Range` and `Cell` (etc) objects
            Set Rngm = .Range(.Cells(2, Col), .Cells(LastRow, Col))
        Else
            MsgBox "The column named like plan_tamaward* was not found in Row1.", vbExclamation, "Column Not Found!"
            Exit Sub
        End If

        'set range for sku
        If Application.CountIf(.Rows(1), "plan_sku_*") > 0 Then
            Col = Application.Match("plan_sku_*", .Rows(1), 0)
            Set RngSku = .Range(.Cells(2, Col), .Cells(LastRow, Col))
        Else
            MsgBox "The column named like plan_sku* was not found in Row1.", vbExclamation, "Column Not Found!"
            Exit Sub
        End If

        ' set range for PO
        'If Application.CountIf(.Rows(1), "plan_sku_*") > 0 Then ' <-- this seems wrong
        If Application.CountIf(.Rows(1), "Rack PO #*") > 0 Then  ' <-- maybe this?
            Col = Application.Match("Rack PO #*", .Rows(1), 0)
            Set RngPO = .Range(.Cells(2, Col), .Cells(LastRow, Col))
        Else
            MsgBox "The column named like Rack PO #* was not found in Row1.", vbExclamation, "Column Not Found!"
            Exit Sub
        End If
    End With

    MsgBox "the range is" & Rngm.Address
    MsgBox "the range is" & RngSku.Address
    MsgBox "the range is" & RngPO.Address

    'Use a With block to save typing 'WBA.Worksheets("Sourcesheet").' 3 times
    With WBA.Worksheets("Sourcesheet")
        .Range("F4").Resize(Rngm.Rows.Count, 1).Value = Rngm.Value
        .Range("E4").Resize(RngSku.Rows.Count, 1).Value = RngSku.Value
        .Range("C4").Resize(RngPO.Rows.Count, 1).Value = RngPO.Value
    End With

    MsgBox "the range is" & Rngm.Address
    MsgBox "the range is" & RngSku.Address
    MsgBox "the range is" & RngPO.Address
End Sub

查找列标题，复制数据以及粘贴另一个工作簿中的值

1 个答案: