Search code examples
excelvbafor-loopcopycopy-paste

Copy and Paste using Range.Copy Method


I am trying to paste values from a bunch of tables into one long list. I have the tables spread across different sheets and the number of rows changes, but the columns do not. Then I am also trying to paste a string value that tells what sheet it came from, but having trouble with the active cell part of the code.

When I first tried it, it did not compile, hence why I came here, to figure out why it did not compile. Going back and forth with urdearboy, below, I was able to get the correct code working here.

I have the following:

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

end sub


Solution

  • This will loop through all sheets, with the exception of Master, and import the values on Column A to Master accompanied by the origin of the data (sheet name).

    Option Explicit for good measure.


    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
    

    To paste values change

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

    to this

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