如何从Excel VBA中的不同工作表复制和粘贴整列数据

我目前正在处理一个脚本，该脚本应该从一个工作表中复制四列数据，并将其粘贴到同一工作簿中的另一个工作表中。 注意到我只需要从第二行开始的数据，我尝试过使用column（）和Range（），但是它似乎没有工作。

下面是只复制第二行中的一个单元格并粘贴到目标工作表中的另一个单元格的脚本。

Sub Sample() Dim lastRow As Long, i As Long Dim CopyRange As Range Dim rw As Range Dim rw1 As Range Dim rw2 As Range Dim rw3 As Range Dim des As Range Dim des1 As Range Dim des2 As Range Dim des3 As Range '~~> Change Sheet1 to relevant sheet name With Sheets(1) lastRow = .Range("A" & .Rows.Count).End(xlUp).Row For i = 2 To lastRow If Len(Trim(.Range("A" & i).Value)) <> 0 Then If CopyRange Is Nothing Then Set CopyRange = .Rows(i) Else Set CopyRange = Union(CopyRange, .Rows(i)) Set rw = Range("P2") Set rw1 = Range("W2") Set rw2 = Range("C2") Set rw3 = Range("R2") End If End If Next If Not CopyRange Is Nothing Then Set des = Sheets(3).Range("P2") Set des1 = Sheets(3).Range("R2") Set des2 = Sheets(3).Range("T2") Set des3 = Sheets(3).Range("U2") '~~> Change Sheet2 to relevant sheet name rw.Copy des rw1.Copy des1 rw2.Copy des2 rw3.Copy des3 Application.CutCopyMode = False End If End With End Sub 

Answer 1

希望这可以帮助

 '// code example copies the Column A on Sheet1 into Column A2 on Sheet2. Sub CopyFourColumns() '// Declare your variables. Dim wSheet1 As Worksheet Dim wSheet2 As Worksheet Dim wSlastRow As Long Dim X As Long Dim RngToCopy As Range Dim RngToPaste As Range '// Set here Workbook(Sheets) names With ThisWorkbook Set wSheet1 = Sheets("Sheet1") Set wSheet2 = Sheets("Sheet2") End With '// Here lets Find the last row of data wSlastRow = wSheet1.Range("A" & Rows.Count).End(xlUp).Row wSlastRow = wSheet1.Range("B" & Rows.Count).End(xlUp).Row wSlastRow = wSheet1.Range("C" & Rows.Count).End(xlUp).Row wSlastRow = wSheet1.Range("D" & Rows.Count).End(xlUp).Row '// Now Loop through each row For x = 1 To wSlastRow Set RngToPaste = wSheet2.Range("A" & (x + 1)) With wSheet1 Set RngToCopy = Union(.Range("A" & x), .Range("A" & x)) RngToCopy.copy RngToPaste Set RngToPaste = wSheet2.Range("B" & (x + 1)) Set RngToCopy = Union(.Range("B" & x), .Range("B" & x)) RngToCopy.copy RngToPaste Set RngToPaste = wSheet2.Range("C" & (x + 1)) Set RngToCopy = Union(.Range("C" & x), .Range("C" & x)) RngToCopy.copy RngToPaste Set RngToPaste = wSheet2.Range("D" & (x + 1)) Set RngToCopy = Union(.Range("D" & x), .Range("D" & x)) RngToCopy.copy RngToPaste End With Next X '// Simple Msg Box MsgBox "Copy & Paste is Done." End Sub