Vba Excel Excel中复制数据的更干净方法是什么?
我正在尝试导入数据,其中项目的数量每天都会发生变化,我只需运行宏即可将数据复制到工作簿中。我现在所拥有的一切都有用。我只是认为这不是最有效的方法。我还希望能够在复制新数据之前清除工作表Vba Excel Excel中复制数据的更干净方法是什么?,vba,excel,copy-paste,Vba,Excel,Copy Paste,我正在尝试导入数据,其中项目的数量每天都会发生变化,我只需运行宏即可将数据复制到工作簿中。我现在所拥有的一切都有用。我只是认为这不是最有效的方法。我还希望能够在复制新数据之前清除工作表 Sub Data() Application.ScreenUpdating = False 'Disables "Screen flashing" between 2 workbooks Dim colA As Integer, colAA As Integer Dim colB As
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
这里有许多地方可以改进:
工作表
,而不是依赖隐式活动工作表
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
要清除工作表,请执行以下操作:
Sheets("sheet1").Select
Selection.AutoFilter
Sheets("sheet1").Cells.Clear
如果复制工作表的文件名始终相同,您可以尝试:录制一个复制宏并将所有数据粘贴到其复制的所有数据或整个工作表上,然后进入并操作代码,从activesheet格式到指定路径,就像您已经在编码一样
可能正在录制宏,右键单击“工作表”选项卡并选择复制或移动。尝试一下:
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
我认为对于这样的任务使用数据连接更简单。这样,您只需通过data->Connections->refresh刷新数据即可 详情如下: 或: 我还创建了一个简单的外接程序,用于在Excel数据上运行SQL查询(运行一次查询将创建数据连接)
SELECT `Sheet1$`.A, `Sheet1$`.B FROM `C:\Users\USERNAME\Desktop\Source.xlsx`.`Sheet1$` `Sheet1$`
3.要刷新数据,只需转到“数据->连接”,找到连接并单击“刷新”难道你不能复制并粘贴数据,而不是在每个单元格的工作簿A和工作簿B之间来回切换吗?不知道是否需要wbA。在复制和wbB之前激活。在粘贴之前激活。:-)工作得很好,非常感谢你的帮助。