Excel Macro: copy row values ​​from one sheet to a specific location on another sheet, based on criteria

I've been working with macros in Excel for about 4 months now and really teach myself by finding the existing code and figuring out how it works. I'm a little stuck.

I have a report in an Excel workbook. I need to copy data across several sheets (in one book) based on the data that appears in column D. That is, I need to copy the entire row where column D meets certain criteria. The original worksheet contains formulas, but I want the values ​​displayed only when copying data.

I was able to copy the data through, but I have two problems: 1) the formulas copy across, not just the values ​​2) the data appears on a new sheet in cell A2, but I need it to start from cell A5

I set this as a template, since the main report needs to be run and split every month, so the range from which I copy will not be constant. This is the sample code that I am currently using:

    Sub RefreshSheets()

    Sheets("ORIGIN").Select
    Dim lr As Long, lr2 As Long, r As Long
    lr = Sheets("ORIGIN").Cells(Rows.Count, "A").End(xlUp).Row
    lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row

    For r = lr To 2 Step -1
        If Range("D" & r).Value = "movedata" Then
            Rows(r).Copy Destination:=Sheets("DESTINATION").Range("A" & lr2 + 1)
            lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row
        End If


    Next r

    End Sub

I tried adding ".PasteSpecial Paste: = xlPasteValues" after ".Range (" A "and lr2 + 1)", but I get a compilation error (Expected: end of instruction). I'm sure I missed something obvious (this is what I get from using code that I still don't quite understand), but nothing I've tried so far has worked.

Any advice is appreciated.

+4
2

For ( )

Option Explicit

Public Sub RefreshSheets()
    Dim wsO As Worksheet, wsD As Worksheet, lrO As Long, lrD As Long, r As Long

    Set wsO = ThisWorkbook.Sheets("ORIGIN")
    Set wsD = ThisWorkbook.Sheets("DESTINATION")
    lrO = wsO.Cells(Rows.Count, "A").End(xlUp).Row
    lrD = wsD.Cells(Rows.Count, "A").End(xlUp).Row

    If lrD < 5 Then lrD = 5

    For r = lrO To 2 Step -1
        If wsO.Range("D" & r).Value2 = "movedata" Then
            wsO.Rows(r).Copy
            wsD.Range("A" & lrD + 1).PasteSpecial xlPasteValues
            lrD = lrD + 1
        End If
    Next
End Sub

AutoFilter "moveata" :

Public Sub RefreshSheetsFast()
    Dim wsO As Worksheet, wsD As Worksheet, lrD As Long

    Set wsO = ThisWorkbook.Sheets("ORIGIN")
    Set wsD = ThisWorkbook.Sheets("DESTINATION")
    lrD = wsD.Cells(Rows.Count, "A").End(xlUp).Row

    If lrD < 5 Then lrD = 5    'Makes sure the first row on DESTINATION sheet is >=5

    If Not wsO.AutoFilter Is Nothing Then wsO.UsedRange.AutoFilter
    With wsO.UsedRange
        .Columns(4).AutoFilter Field:=1, Criteria1:="movedata"
        .Offset(1).Resize(.Rows.Count - 1).Copy        'Excludes the header (row 1)
    End With
    wsD.Range("A" & lrD + 1).PasteSpecial xlPasteValues

    Application.CutCopyMode = False
    wsO.UsedRange.AutoFilter    'Removes the "movedata" filter
End Sub
+2

:

Sub RefreshSheets()
  Sheets("ORIGIN").Select
  Dim lr As Long, lr2 As Long, r As Long
  lr = Sheets("ORIGIN").Cells(Rows.Count, "A").End(xlUp).Row
  lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row

  For r = lr To 2 Step -1
      If Range("D" & r).Value = "movedata" Then
          Rows(r).Copy
          Sheets("DESTINATION").Range("A" & lr2 + 1).PasteSpecial xlPasteValues
          lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row
      End If
  Next r
End Sub
+1

Source: https://habr.com/ru/post/1682356/


All Articles