使用 Range.Copy 方法复制和粘贴

Question

我正在尝试将一堆表格中的值粘贴到一个长列表中。我将表格分布在不同的 sheet 中，并且行数发生了变化，但列却没有。然后我还尝试粘贴一个字符串值，告诉它 sheet 它来自什么，但是在代码的活动单元格部分遇到问题。

我第一次试的时候，编译不通过，所以我才来这里，搞清楚编译不通过的原因。与下面的 urdearboy 来回交流，我能够在这里获得正确的代码。

我有以下内容：

sub copypaste()
  Dim ws1 as worksheet
  dim ws2 as worksheet
  dim mas as worksheet
  Set ws1 =ThisWorkbook.Sheets("Sheet1")
  Set ws2=ThisWorkbook.Sheets("Sheet2")
  Set mas=ThisWorkbook.Sheets("Master") 'where I create my list

     For Each ws In Worksheets
    If ws.Name <> mas.Name Then
        LRow = mas.Range("A" & mas.Rows.Count).End(xlUp).Offset(1, 0).Row
        wsLRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        ws.Range("A2:A" & wsLRow - 1).Copy
        mas.Range("A" & LRow).PasteSpecial Paste:=xlPasteValues
        ws.Range("B2:B" & wsLRow - 1).Copy
        mas.Range("B" & LRow).PasteSpecial Paste:=xlPasteValues
        mas.Range(mas.Cells(LRow, 4), mas.Cells(wsLRow + LRow - 2, 4)) = ws.Name 'I need my sheet value in the fourth column, not the third, but simply change the col coordinate in the Cells equation above

    End If
Next ws

'In order to figure out the sheet name, I used the following:
Dim rng As Range
Set rng = mas.Range("D2", Range("D2").End(xlDown))
For Each Cell In rng
    If Cell.Value = "Sheet 1" Then
        Cell.Value = "S1"
    ElseIf Cell.Value = "Sheet 2" Then
        Cell.Value = "S2"
    End If
Next Cell

结束子

Answer 1

这将遍历 all sheets，Master 除外，并将 A 列的值导入到 Master附有数据来源（sheet 名称）。

Option Explicit 很好的衡量标准。

Option Explicit

Sub copypaste()

Dim mas As Worksheet: Set mas = ThisWorkbook.Sheets("Master")
Dim ws As Worksheet, LRow As Long, wsLRow As Long

Application.ScreenUpdating = False
    For Each ws In Worksheets
        If ws.Name <> mas.Name Then
            LRow = mas.Range("A" & mas.Rows.Count).End(xlUp).Offset(1).Row
            wsLRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
            ws.Range("A2:A" & wsLRow).Copy mas.Range("A" & LRow)
            mas.Range(mas.Cells(LRow, 2), mas.Cells(wsLRow + LRow - 2, 2)) = ws.Name
        End If
    Next ws
Application.ScreenUpdating = True

End Sub

要粘贴值更改

ws.Range("A2:A" & wsLRow).Copy mas.Range("A" & LRow)

至此

ws.Range("A2:A" & wsLRow).Copy
mas.Range("A" & LRow).PasteSpecial xlPasteValues

使用 Range.Copy 方法复制和粘贴

Copy and Paste using Range.Copy Method

excel

vba

for-loop

copy

copy-paste