将特定范围复制到另一个Excel工作簿中

时间:2018-05-01 13:13:23

标签: excel excel-vba vba

我希望将特定范围的数据从一个工作簿导出到主工作簿。我已经想出如何从一个到另一个整体复制,但我想修改我现有的编码。目前,宏正在从工作簿中取出所有第2行并将其复制到这个工作簿的主文件中,但是我希望在主文件中做更多的事情所以我只需要A2列:HD2来复制和粘贴进入主表。以下是我们正在使用的内容,任何人都可以帮我弄清楚如何将A2:HD2而不是第2行全部放入我的主表中吗?

Dim LN, Match As Integer
Dim wb As Workbook
Dim Name As String
Name = "Master sheet path here"

Application.ScreenUpdating = False

Sheets("LADB Bulk Upload").Select
LN = Range("A2").Value



Rows("2:2").Select
Selection.Copy

Set wb = Workbooks.Open(Filename:=Name)
If IsError(Application.Match(LN, ActiveSheet.Range("A:A"), 0)) Then

    Range("A100000").End(xlUp).Select
    ActiveCell.Offset(1, 0).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Else

    Match = Application.Match(LN, wb.Sheets("Sheet1").Range("A:A"), 0)

    Cells(Match, 1).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End If

Application.CutCopyMode = False

ActiveWorkbook.Save
ActiveWorkbook.Close

Application.ScreenUpdating = True

2 个答案:

答案 0 :(得分:0)

替换

Rows("2:2").Select
Selection.Copy

使用

Range("A2:HD2").Copy

理想情况下,您应该使用范围而不是使用Select。你会在其他地方找到很多关于它的信息。也就是说,如果代码有效,并且速度不是特别慢,那就不重要了。

答案 1 :(得分:0)

此代码refactored仅复制A2:HD2范围,不使用Select

Option Explicit

Public Sub CopyA2HD2()
    Dim mainWb As Workbook, mainWs As Worksheet, mainLr As Long, mainCol As Range
    Dim thisWs As Worksheet, findTxt As String, foundCell As Variant

    Set thisWs = ThisWorkbook.Worksheets("LADB Bulk Upload")    'Current file

    Application.ScreenUpdating = False
    On Error Resume Next 'Expected errors: File not found, and Sheet Name not found
    Set mainWb = Workbooks.Open(Filename:="Master sheet path here")

    If Err.Number = 0 Then    'If master file is found, and open, continue
        Set mainWs = mainWb.Worksheets("Sheet1")
        If Err.Number > 0 Then Exit Sub    'If "Sheet1" in master file is not found exit
        mainLr = mainWs.Cells(mainWs.Rows.Count, "A").End(xlUp).Row 'Last row in master
        Set mainCol = mainWs.Range(mainWs.Cells(1, "A"), mainWs.Cells(mainLr, "A"))

        findTxt = thisWs.Range("A2").Value
        foundCell = Application.Match(findTxt, mainCol, 0) 'Search column A in master

        If Not IsError(foundCell) Then                     'If text was found in master
            Set foundCell = mainWs.Cells(foundCell, "A")   'Copy A2:HD2 to same row
        Else
            Set foundCell = mainWs.Cells(mainLr + 1, "A")  'Else, copy A2:HD2 to last row
        End If

        thisWs.Range("A2:HD2").Copy
        foundCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
        foundCell.Select
        Application.CutCopyMode = False
        mainWb.Close SaveChanges:=True
    End If
    Application.ScreenUpdating = True
End Sub

关于您的代码的一些注释

  • 如上所述,avoid using Select and Activate如果可能的话
  • 在每个模块的顶部使用Option Explicit,因此编译器可以捕获缺少的变量
  • 不要将保留关键字用作变量名,以避免遮挡内置对象
    • NameMatch等词语
  • Use Long variable type instead of Integer
    • 根据MSDN VBA默默地将所有Integers转换为Longs
  • 始终明确引用范围:Rows("2:2")隐式使用ActiveSheet
    • 需要进行大量的维护和保养工作才能确保预期的工作表处于活动状态
  • 代码缩进和适当的垂直空白将有助于可视化结构和流程更清晰