Excel-Excel中復制數據的更干凈方法是什么？

Question

我正在嘗試導入數據，其中項的數量每天都會更改，而我只需要運行宏即可將數據復制到工作簿中。 我目前擁有的作品。 我只是相信這不是最有效的方法。 我還希望能夠在復制新數據之前清除工作表。

Sub Data()

    Application.ScreenUpdating = False 'Disables "Screen flashing" between 2 workbooks

    Dim colA As Integer, colAA As Integer
    Dim colB As Integer, colBB As Integer
    Dim colC As Integer, colCC As Integer
    Dim colD As Integer, colDD As Integer
    Dim colE As Integer, colEE As Integer
    Dim colF As Integer, colFF As Integer
    Dim colG As Integer, colGG As Integer
    Dim colH As Integer, colHH As Integer
    Dim colI As Integer, colII As Integer
    Dim colJ As Integer, colJJ As Integer
    Dim colK As Integer, colKK As Integer
    Dim colL As Integer, colLL As Integer
    Dim colM As Integer, colMM As Integer
    Dim colN As Integer, colNN As Integer
    Dim colO As Integer, colOO As Integer

    Dim rowA As Integer, rowAA As Integer
    Dim rowB As Integer, rowBB As Integer
    Dim rowC As Integer, rowCC As Integer
    Dim rowD As Integer, rowDD As Integer
    Dim rowE As Integer, rowEE As Integer
    Dim rowF As Integer, rowFF As Integer
    Dim rowG As Integer, rowGG As Integer
    Dim rowH As Integer, rowHH As Integer
    Dim rowI As Integer, rowII As Integer
    Dim rowJ As Integer, rowJJ As Integer
    Dim rowK As Integer, rowKK As Integer
    Dim rowL As Integer, rowLL As Integer
    Dim rowM As Integer, rowMM As Integer
    Dim rowN As Integer, rowNN As Integer
    Dim rowO As Integer, rowOO As Integer

    Dim wbA As Workbook, wbB As Workbook
    Dim bws As Worksheet

    Set wbA = Workbooks.Open("C:\Users\Carrak\Desktop\Data\New Format\Maximo.xlsx.")
    Set wbB = ThisWorkbook

    colAA = 1 'Replace "1" with the number of the column FROM which you're copying
    colBB = 45 'Replace "1" with the number of the column FROM which you're copying
    colCC = 6 'Replace "1" with the number of the column FROM which you're copying
    colDD = 7 'Replace "1" with the number of the column FROM which you're copying
    colEE = 8 'Replace "1" with the number of the column FROM which you're copying
    colFF = 9 'Replace "1" with the number of the column FROM which you're copying
    colGG = 10 'Replace "1" with the number of the column FROM which you're copying
    colHH = 11 'Replace "1" with the number of the column FROM which you're copying
    colII = 28 'Replace "1" with the number of the column FROM which you're copying
    colJJ = 31 'Replace "1" with the number of the column FROM which you're copying
    colKK = 34 'Replace "1" with the number of the column FROM which you're copying
    colLL = 53 'Replace "1" with the number of the column FROM which you're copying
    colMM = 54 'Replace "1" with the number of the column FROM which you're copying
    colNN = 55 'Replace "1" with the number of the column FROM which you're copying
    colOO = 56 'Replace "1" with the number of the column FROM which you're copying


    colA = 1 'Replace "1" with the number of the column TO which you're copying
    colB = 3 'Replace "1" with the number of the column TO which you're copying
    colC = 5 'Replace "1" with the number of the column TO which you're copying
    colD = 6 'Replace "1" with the number of the column TO which you're copying
    colE = 7 'Replace "1" with the number of the column TO which you're copying
    colF = 8 'Replace "1" with the number of the column TO which you're copying
    colG = 9 'Replace "1" with the number of the column TO which you're copying
    colH = 10 'Replace "1" with the number of the column TO which you're copying
    colI = 11 'Replace "1" with the number of the column TO which you're copying
    colJ = 12 'Replace "1" with the number of the column TO which you're copying
    colK = 13 'Replace "1" with the number of the column TO which you're copying
    colL = 14 'Replace "1" with the number of the column TO which you're copying
    colM = 15 'Replace "1" with the number of the column TO which you're copying
    colN = 16 'Replace "1" with the number of the column TO which you're copying
    colO = 17 'Replace "1" with the number of the column TO which you're copying

    rowAA = 2 'Replace "1" with the number of the starting row of the column FROM which you're copying
    rowAA = 2 'Replace "1" with the number of the starting row of the column FROM which you're copying
    rowAA = 2 'Replace "1" with the number of the starting row of the column FROM which you're copying
    rowAA = 2 'Replace "1" with the number of the starting row of the column FROM which you're copying
    rowAA = 2 'Replace "1" with the number of the starting row of the column FROM which you're copying
    rowAA = 2 'Replace "1" with the number of the starting row of the column FROM which you're copying
    rowAA = 2 'Replace "1" with the number of the starting row of the column FROM which you're copying
    rowAA = 2 'Replace "1" with the number of the starting row of the column FROM which you're copying
    rowAA = 2 'Replace "1" with the number of the starting row of the column FROM which you're copying
    rowAA = 2 'Replace "1" with the number of the starting row of the column FROM which you're copying
    rowAA = 2 'Replace "1" with the number of the starting row of the column FROM which you're copying
    rowAA = 2 'Replace "1" with the number of the starting row of the column FROM which you're copying
    rowAA = 2 'Replace "1" with the number of the starting row of the column FROM which you're copying
    rowAA = 2 'Replace "1" with the number of the starting row of the column FROM which you're copying
    rowAA = 2 'Replace "1" with the number of the starting row of the column FROM which you're copying

    rowA = 2 'Replace "1" with the number of the row of the column TO which you're copying
    rowB = 2 'Replace "1" with the number of the row of the column TO which you're copying
    rowC = 2 'Replace "1" with the number of the row of the column TO which you're copying
    rowD = 2 'Replace "1" with the number of the row of the column TO which you're copying
    rowE = 2 'Replace "1" with the number of the row of the column TO which you're copying
    rowF = 2 'Replace "1" with the number of the row of the column TO which you're copying
    rowG = 2 'Replace "1" with the number of the row of the column TO which you're copying
    rowH = 2 'Replace "1" with the number of the row of the column TO which you're copying
    rowI = 2 'Replace "1" with the number of the row of the column TO which you're copying
    rowJ = 2 'Replace "1" with the number of the row of the column TO which you're copying
    rowK = 2 'Replace "1" with the number of the row of the column TO which you're copying
    rowL = 2 'Replace "1" with the number of the row of the column TO which you're copying
    rowM = 2 'Replace "1" with the number of the row of the column TO which you're copying
    rowN = 2 'Replace "1" with the number of the row of the column TO which you're copying
    rowO = 2 'Replace "1" with the number of the row of the column TO which you're copying


        wbA.Activate

            lastAA = Cells(Rows.Count, colAA).End(xlUp).Row 'This finds the last row of the data of the column FROM which you're copying
            For x = rowAA To lastAA 'Loops through all the rows of A
        wbA.Activate
            yourData = Cells(x, colAA)
        wbB.Sheets("Data").Activate
            Cells(rowA, colA) = yourData
            rowA = rowA + 1 'Increments the current line of destination workbook
            Next x 'Skips to next row
            For x = rowAA To lastAA 'Loops through all the rows of A
        wbA.Activate
            yourData = Cells(x, colBB)
            wbB.Sheets("Data").Activate
            Cells(rowB, colB) = yourData
            rowB = rowB + 1 'Increments the current line of destination workbook
            Next x 'Skips to next row
            For x = rowAA To lastAA 'Loops through all the rows of A
        wbA.Activate
            yourData = Cells(x, colCC)
            wbB.Activate
            Cells(rowC, colC) = yourData
            rowC = rowC + 1 'Increments the current line of destination workbook
            Next x 'Skips to next row
            For x = rowAA To lastAA 'Loops through all the rows of A
        wbA.Activate
            yourData = Cells(x, colDD)
        wbB.Activate
            Cells(rowD, colD) = yourData
            rowD = rowD + 1 'Increments the current line of destination workbook
            Next x 'Skips to next row
            For x = rowAA To lastAA 'Loops through all the rows of A
        wbA.Activate
            yourData = Cells(x, colEE)
        wbB.Activate
            Cells(rowE, colE) = yourData
            rowE = rowE + 1 'Increments the current line of destination workbook
            Next x 'Skips to next row
            For x = rowAA To lastAA 'Loops through all the rows of A
        wbA.Activate
            yourData = Cells(x, colFF)
        wbB.Activate
            Cells(rowF, colF) = yourData
            rowF = rowF + 1 'Increments the current line of destination workbook
            Next x 'Skips to next row
            For x = rowAA To lastAA 'Loops through all the rows of A
        wbA.Activate
            yourData = Cells(x, colGG)
        wbB.Activate
            Cells(rowG, colG) = yourData
            rowG = rowG + 1 'Increments the current line of destination workbook
            Next x 'Skips to next row
            For x = rowAA To lastAA 'Loops through all the rows of A
        wbA.Activate
            yourData = Cells(x, colHH)
        wbB.Activate
            Cells(rowH, colH) = yourData
            rowH = rowH + 1 'Increments the current line of destination workbook
            Next x 'Skips to next row
            For x = rowAA To lastAA 'Loops through all the rows of A
        wbA.Activate
            yourData = Cells(x, colII)
        wbB.Activate
            Cells(rowI, colI) = yourData
            rowI = rowI + 1 'Increments the current line of destination workbook
            Next x 'Skips to next row
            For x = rowAA To lastAA 'Loops through all the rows of A
        wbA.Activate
            yourData = Cells(x, colJJ)
            wbB.Activate
            Cells(rowJ, colJ) = yourData
            rowJ = rowJ + 1 'Increments the current line of destination workbook
            Next x 'Skips to next row
            For x = rowAA To lastAA 'Loops through all the rows of A
        wbA.Activate
            yourData = Cells(x, colKK)
        wbB.Activate
            Cells(rowK, colK) = yourData
            rowK = rowK + 1 'Increments the current line of destination workbook
            Next x 'Skips to next row
            For x = rowAA To lastAA 'Loops through all the rows of A
        wbA.Activate
            yourData = Cells(x, colLL)
        wbB.Activate
            Cells(rowL, colL) = yourData
            rowL = rowL + 1 'Increments the current line of destination workbook
            Next x 'Skips to next row
            For x = rowAA To lastAA 'Loops through all the rows of A
        wbA.Activate
            yourData = Cells(x, colMM)
            wbB.Activate
            Cells(rowM, colM) = yourData
            rowM = rowM + 1 'Increments the current line of destination workbook
            Next x 'Skips to next row
            For x = rowAA To lastAA 'Loops through all the rows of A
        wbA.Activate
            yourData = Cells(x, colNN)
        wbB.Activate
            Cells(rowN, colN) = yourData
            rowN = rowN + 1 'Increments the current line of destination workbook
            Next x 'Skips to next row
            For x = rowAA To lastAA 'Loops through all the rows of A
        wbA.Activate
            yourData = Cells(x, colOO)
        wbB.Activate
            Cells(rowO, colO) = yourData
            rowO = rowO + 1 'Increments the current line of destination workbook
            Next x 'Skips to next row
        Application.ScreenUpdating = True 'Re-enables Screen Updating

End Sub

Answer 1

這里有許多可以改進的地方：

1. 指定您的WorkSheet ，而不是依靠隱式ActiveSheet
2. 使用對象引用而不是激活書/頁
3. 使用更緊湊，更容易迭代的數據結構，例如數組
4. 將重復的代碼（復制）分離到一個單獨的例程中
5. 一次性復制每個范圍，而不是循環

像這樣：

Sub Demo()
    ' Declare all your variables
    Dim wbA As Workbook, wbB As Workbook
    Dim wsA As Worksheet, wsB As Worksheet

    Dim Data() As Variant
    Dim i As Long

    ' Specify Source and Destination, Workbook and WorkSheet
    Set wbA = Workbooks.Open("C:\Users\Carrak\Desktop\Data\New Format\Maximo.xlsx.")
    Set wsA = wbA.Worksheets("SpecifySheetName")

    Set wbB = ThisWorkbook
    Set wsB = wbA.Worksheets("SpecifySheetName")

    ' Set up source and destination data
    '    RowFrom , ColFrom, RowTo, ColTo
    Data = Array( _
      Array(2, 1, 2, 1), _
      Array(2, 45, 2, 3), _
      Array(2, 6, 2, 5), _
      Array(2, 7, 2, 6), _
      Array(2, 8, 2, 7), _
      Array(2, 9, 2, 8), _
      Array(2, 10, 2, 9), _
      Array(2, 11, 2, 10), _
      Array(2, 28, 2, 11), _
      Array(2, 31, 2, 12), _
      Array(2, 34, 2, 13), _
      Array(2, 53, 2, 14), _
      Array(2, 54, 2, 15), _
      Array(2, 55, 2, 16), _
      Array(2, 56, 2, 17))

    ' Clear Destination sheet
    wsB.Cells.Clear

    ' Copy Data
    For i = LBound(Data, 1) To UBound(Data, 1)
        CopyData wsA, Data(i)(0), Data(i)(1), wsB, Data(i)(2), Data(i)(3)
    Next
End Sub

Sub CopyData(wsSource As Worksheet, rwSource As Variant, clSource As Variant, _
  wsDest As Worksheet, rwDest As Variant, clDest As Variant)
    Dim rng As Range
    With wsSource
        Set rng = .Range(.Cells(rwSource, clSource), .Cells(.Rows.Count, clSource).End(xlUp))
    End With

    With wsDest
        .Cells(rwDest, clDest).Resize(rng.Rows.Count, rng.Columns.Count).Value = _
          rng.Value
    End With
End Sub

Answer 2

清除工作表：

Sheets("sheet1").Select

Selection.AutoFilter

Sheets("sheet1").Cells.Clear

如果復制表的文件名始終相同，則可以嘗試：記錄復制宏並將所有數據粘貼到其復制所有數據或整個表的位置，然后進入並處理活動表格式中的代碼以指定像您已經在編碼中那樣的路徑。

可能錄制宏，然后右鍵單擊工作表選項卡，然后選擇復制或移動。

Answer 3

我認為將數據連接用於此類任務更為簡單。 這樣，您可以簡單地通過Data-> Connections-> Refresh刷新數據。

此處更多內容： https : //www.google.pl/search?sourceid=chrome-psyapi2&ion=1&espv=&ie=UTF-8&q=data%20connection%20to%20excel%20workbook

或者：我還創建了一個簡單的加載項，用於對Excel數據運行SQL查詢（運行一次查詢將創建數據連接）。

1. 您可以在此處查找加載項： http : //blog.tkacprow.pl/?p=91

2. 假設您有一個名為Source.xlsx的工作簿，在工作表中名為“ Sheet1”的數據（兩個數據列“ A”和“ B”），並且您要將數據復制到當前工作簿。 SQL將是：

    SELECT `Sheet1$`.A, `Sheet1$`.B FROM `C:\\Users\\USERNAME\\Desktop\\Source.xlsx`.`Sheet1$` `Sheet1$` 

這會將Source.xlsx工作簿的工作表“ Sheet1”的名為“ A”的列和“ B”的列的所有數據復制到表單的第一個參數中指定的數據范圍。 3.要刷新數據，只需轉到“數據”->“連接”，找到連接，然后單擊“刷新”。

Answer 4

試一下：

Sub Test()
' Declare all your variables
Dim wbA As Workbook, wbB As Workbook


Application.ScreenUpdating = False
' Specify Source and Destination, Workbook and WorkSheet

Set wbA = Workbooks.Open("C:\Users\Carrak\Desktop\Data\New Format\Maximo.xlsx.")
Set wbB = ThisWorkbook


wbB.Sheets("Data").Select
Selection.AutoFilter
wbB.Sheets("Data").Cells.Clear


wbA.sheets("sheet1").range("A1:Z500").copy 'change sheet1 as needed A1:Z500 to your range
wbB.sheets("Data").range("A1").pastespecial 'change sheet1 as needed


wbB.Save
wbA.Close 
wbB.Activate 
Application.ScreenUpdating = True 'Re-enables Screen Updating

End sub ()

或以下所示，因為數據量每天都是動態的。

wbA.sheets("sheet1").cells.copy 

代替

wbA.sheets("sheet1").range("A1:Z500").copy