[英]Copy paste special VBA
我是一名葡萄牙语工程师,最近我开始在Visual Basic中通过名为“ Livro MQTEN”的工作簿上名为“Início”的特定工作表上的按钮进行编程。 在“Início”工作表上,我有一个带有以下代码的按钮:
Private Sub CommandButton1_Click()
Dim lngCount As Long
Dim j As String
Dim fileName As String
Dim lngIndex As Long
Dim strPath() As String
Dim nome As String
Dim folha As String
' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
.Title = "Selecione o ficheiro dos comboios realizados do dia"
.InitialFileName = "Explor. *"
.AllowMultiSelect = False
.Show
.Filters.Add "Excel files", "*.xlsx; *.xls", 1
' Display paths of each file selected
For lngCount = 1 To .SelectedItems.Count
'MsgBox .SelectedItems(lngCount)
j = .SelectedItems(lngCount)
'MsgBox (j)
strPath() = Split(j, "\") 'Put the Parts of our path into an array
lngIndex = UBound(strPath)
fileName = strPath(lngIndex) 'Get the File Name from our array
'MsgBox (fileName)
nome = fileName
'Get name of sheet
Dim wb As Workbook
Dim ws As Worksheet
Dim TxtRng As Range
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Início")
ws.Unprotect
Set TxtRng = ws.Range("D17")
TxtRng.Value = nome
ws.Protect
folha = Cells.Item(21, 6)
'MsgBox (folha)
'Copy from sheet
Dim x As Workbook, y As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim SrcRange As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set x = Workbooks.Open(j)
Set y = ThisWorkbook
Set ws1 = x.Sheets(folha)
Set ws2 = y.Sheets("Explor. do Mês")
Set CopyData = ws1.Range("A1:M8000").EntireColumn
CopyData.Copy
Set Addme = ws2.Range("A1:M8000")
Addme.PasteSpecial xlPasteValues
x.Close True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Next lngCount
End With
End Sub
在代码中:
Set CopyData = ws1.Range("A1:M8000").EntireColumn
CopyData.Copy
Set Addme = ws2.Range("A1:M8000")
Addme.PasteSpecial xlPasteValues
我将整个列从A列粘贴到M列。我仅需要复制和PasteSpecial工作表ws1中具有对工作表ws2值的单元格。 然后,如果我再次单击按钮并选择另一个工作簿,则将值添加到ws2而不是覆盖它们。 如何在Visual Basic中做到这一点? 我在这里想念的是什么? 拜托,我真的非常需要您的帮助! 提前致谢。
解决了!
刚刚将上面的代码更改为:
With ws2
'Presuming the column "A" in ws2 will always contain the last row.
intLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
'Presuming we will ALWAYS copy the "A1:M8000" range, and that the column "A" is filled.
'Because we determine the last used row based on this column in ws2 (intLastRow)
ws1.Range("A1:M8000").Copy
.Cells(intLastRow + 1, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
并在变量声明中添加以下内容:
Dim intLastRow As Integer
您可以尝试使用“ For”方法分别读取每个单元格。仅当单元格不为空时,以下代码才会从sheet1复制,并且仅在sheet2中的单元格未填充时才会粘贴
'this one will run each row
For i = 1 to 8000
'this one will run each collumn
For j = 1 to 13
If ws1.cells(i,j) <> "" then
ws1.cells(i,j).copy
if ws2.cells(i,j) = "" then
ws2.cells(i,j).PasteSpecial xlPasteValues
Else:
cutcopymode=false
End if
End if
Next
Next
更改复制代码与此:
Dim intLastRow As Integer 'put it where you declare variables.
'Maybe use long, if data on ws2 can exceed 32K rows or something like that.
With ws2
'Presuming the column "A" in ws2 will always contain the last row.
intLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
'Presuming we will ALWAYS copy the "A1:M8000" range, and that the column "A" is filled.
'Because we determine the last used row based on this column in ws2 (intLastRow)
.Range(.Cells(intLastRow + 1, 1), .Cells(intLastRow + 1, 13)) = ws1.Range("A1:M8000").Value
End With
根据OP的注释修改了代码。 现在具有正确的Range("A1:M8000")
和Cells(intLastRow + 1, 13)
With ws2
'Presuming the column "A" in ws2 will always contain the last row.
intLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
'Presuming we will ALWAYS copy the "A1:M8000" range, and that the column "A" is filled.
'Because we determine the last used row based on this column in ws2 (intLastRow)
ws1.Range("A1:M8000").Copy
.Cells(intLastRow + 1, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.