Excel VBA宏,它将复制一系列单元格并粘贴到另一个工作簿中



我正在尝试为电子表格创建一个宏,该宏将从另一个电子表格的第一列导入值。我找到了一个可以手动执行此操作的宏,但如果可能的话,我想使其成为一个自动过程,以便只需单击一个按钮即可更新。下面是我找到的原始宏:

Sub ImportDatafromotherworksheet()
Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook As Workbook
Dim rngSourceRange As Range
Dim rngDestination As Range
Set wkbCrntWorkBook = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
Workbooks.Open .SelectedItems(1)
Set wkbSourceBook = ActiveWorkbook
Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="A1", Type:=8)
wkbCrntWorkBook.Activate
Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="A1", Type:=8)
rngSourceRange.Copy rngDestination
rngDestination.CurrentRegion.EntireColumn.AutoFit
wkbSourceBook.Close False
End If
End With
End Sub

我已经做了一些编辑,但由于我真的不了解 VBA,所以我有点卡住了。这就是我现在所处的位置。任何帮助将不胜感激!

Private Sub CommandButton1_Click()
Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook As Workbook
Dim rngSourceRange As Range
Dim rngDestination As Range
Set wkbCrntWorkBook = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
Workbooks.Open .SelectedItems(1)
Set wkbSourceBook = ActiveWorkbook
Set rngSourceRange = Range(A2:A500)
wkbCrntWorkBook.Activate
Set rngDestination = Range(A2)
rngSourceRange.Copy
rngDestination.PasteSpecial Paste:=xlPasteValues
rngDestination.CurrentRegion.EntireColumn.AutoFit
wkbSourceBook.Close False
End If
End With
End Sub

范围的末尾不必是 500,我只想确保捕获现在和将来范围内的所有值。如果还有一种方法可以使宏仅选择旁边列(B(中有数据的单元格,我很想听听一些建议!

谢谢!

尝试:

Sub test()
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = Workbooks("Book1")
Set wb2 = Workbooks("Book2")
Dim LastRowS1CA As Long
Dim LastRowS2CA As Long
LastRowS1CA = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
wb1.Sheets("Sheet1").Range("A1:A" & LastRowS1CA).Copy '<=== Copy Range from Workbook Book 1 sheet1
LastRowS2CA = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
wb2.Sheets("Sheet1").Range("A" & LastRowS2CA).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False '<=== Paste range to workbook Book 2 sheet2
End Sub

相关内容

最新更新