如何复制一张纸中的特定列并粘贴到另一张纸中的不同范围? [英] How to copy specific columns from one sheet and paste in another sheet in a different range?
问题描述
我是一个初学者,下面有这段代码,但这只是复制工作表的最后一行并将其粘贴到工作表2范围内.基本上,空行不会更新.并且还会引发运行时错误1004-应用程序定义或对象定义的错误.任何帮助将不胜感激.
I am a beginner and I have this code below, but this just copies the last row from sheet and pastes into sheet 2 range. Basically the empty row is not getting updated. And also throws run time error 1004 - Application defined or object defined error. Any help would be much appreciated.
Sub copypaste()
Dim lastrow As Long, erow As Long
lastrow = ThisWorkbook.Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
Sheet1.Cells(i, 3).Copy
erow = ThisWorkbook.Worksheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(erow, 2)
Sheet1.Cells(i, 14).Copy
Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(erow, 4)
Sheet1.Cells(i, 6).Copy
Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(erow, 3)
Next i
Application.CutCopyMode = False
ThisWorkbook.Worksheets("sheet2").Columns().AutoFit
Range("A1").Select
End Sub
让我们说这是工作表1工作表1
Lets say this is sheet 1 sheet 1
,这是sheet2: sheet2:
and this is sheet2: sheet2:
标题在命名上稍有不同,并且位置也发生了变化.并且工作表1中的最后一行是可变的.
Where the headers are slightly different in naming and there's also a position change. And the last row in sheet 1 is varied.
推荐答案
尝试一下,始终最好避免复制和粘贴.
Try this, always better to avoid copy and paste.
Sub copypaste()
Dim lastrow As Integer, erow As Integer, sheet1 As Worksheet, sheet2 As Worksheet
Set sheet1 = Worksheets("Sheet1")
Set sheet2 = Worksheets("Sheet2")
lastrow = sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
erow = sheet2.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
sheet2.Cells(erow, 2) = sheet1.Cells(i, 3)
sheet2.Cells(erow, 3) = sheet1.Cells(i, 6)
sheet2.Cells(erow, 4) = sheet1.Cells(i, 14)
Next i
'ThisWorkbook.Worksheets("Sheet2").Columns().AutoFit
'sheet1.Cells(1, 1).Activate
End Sub
这篇关于如何复制一张纸中的特定列并粘贴到另一张纸中的不同范围?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!