我希望将特定范围的数据从一个工作簿导出到主工作簿。我已经想出如何从一个到另一个整体复制,但我想修改我现有的编码。目前,宏正在从工作簿中取出所有第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
答案 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
关于您的代码的一些注释
Select
and Activate
如果可能的话Option Explicit
,因此编译器可以捕获缺少的变量Name
,Match
等词语Long
variable type instead of Integer
Integers
转换为Longs
Rows("2:2")
隐式使用ActiveSheet