簡體   English   中英

Excel VBA宏,它將復制一系列單元格並粘貼到另一個工作簿中

[英]Excel VBA macro that will copy a range of cells and paste into another workbook

我正在嘗試為電子表格創建一個宏,該宏將從另一個電子表格的第一列中導入值。 我已經找到了一個可以手動執行的宏,但是如果可能的話,我想使其成為一個自動過程,以便只需單擊一個按鈕即可對其進行更新。 以下是我發現的原始宏:

    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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM