Search code examples
vbaexcelcriteriacopy-paste

Copy to other worksheets depending on criteria

I am all new to VBA and are stuck. I have seen some Youtube videos and some threads here, but it is complicated for me - I hope, that some of you can help me :)

I use the macro below and have these obstacles with it.

  1. When I run it, it leaves the first rows empty and when I insert new data and run it, Again, it just moves everything Down perfectly as I wanted it, but it dosent fill the empty cells - It just starts at row 17, because in the worksheet Opgørsel I have 17 rows filled with data - I dont know, why it jumps like that.

  2. In sheet opgørsel, I have 12 options in cell D3 and depending on which option is chosen, I want it to copy it to that sheet - I have made 12 sheets as well - But I dont know how to make it like that.

.

Sub Copypastemeddata()
    Worksheets("Opgørsel").Activate
    Range("A1").CurrentRegion.Copy
    Worksheets("Opsamling").Activate
    Range("A1").PasteSpecial
    Range("A1").PasteSpecial xlPasteValues
    Range("A1").PasteSpecial xlPasteColumnWidths
    Selection.Insert Shift:=xlDownenter
End Sub
Solution

  • Here is what something might look like that uses D3 to target copying to another sheet. I expect this would have to be further refined as you supply more detail. This assume D3 hold a valid sheet name to copy to. It continually takes everything from the source sheet so you will end up with duplicate data. If you only want new rows transferred then you will need to track row count somewhere (potentially in another sheet).

    Option Explicit

Sub Copypastemeddata()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim sourceCell As Range
    Dim targetSheet As Worksheet

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Opgørsel")

    Set sourceCell = ws.Range("D3")  'Cell with sheet names for copying to

    With ws

          Set targetSheet = wb.Worksheets(sourceCell.Text)

          Dim nextRow As Long
          nextRow = GetLastRow(targetSheet, 1)
          nextRow = IIf(nextRow = 1, 1, nextRow + 1)

         .Range("A1").CurrentRegion.Copy targetSheet.Range("A" & nextRow)

    End With

End Sub


Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long

    With ws

      GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row

    End With

End Function

    Example:

    Test run