Better way to copy data entries from one sheet to another

zezspecs

New Member
Joined
May 7, 2021
Messages
6
Office Version
  1. 2010
Platform
  1. Windows
Hi. I'm trying to figure out if there's a better way to work this code. I want to copy certain data entries from one sheet into specific cells in another sheet. Right now, it works as long as there are less than 4 data entries to copy. I'd like to have it so that it works for more without having to add more If Not statements. My VBA knowledge is pretty limited, so any insight would be great!


VBA Code:
Sub CopyPasta()

   Sheets("Copy").Select
   Dim Fnd As Range, Cl As Range
   
   Set Fnd = Range("1:1").Find("Notes", , , xlWhole, , , False, , False)
   If Fnd Is Nothing Then
      MsgBox "Notes Not Found"
      Exit Sub
   End If
   For Each Cl In Range(Fnd, Cells(Rows.Count, Fnd.Column).End(xlUp))
      If Cl.Value = "Flip" Then
        ActiveCell.Select
        Cl.Offset(0, -13).Range("A1").Select
        Selection.Copy
        Sheets("Paste").Select
        Range("A2").Select
        If Not IsEmpty(ActiveCell.Value) Then
            ActiveCell.Offset(6, 0).Cells.Select
            End If
        If Not IsEmpty(ActiveCell.Value) Then
            ActiveCell.Offset(6, 0).Cells.Select
            End If
        If Not IsEmpty(ActiveCell.Value) Then
            ActiveCell.Offset(6, 0).Cells.Select
            End If
        ActiveSheet.Paste
        Sheets("Copy").Select
        ActiveCell.Offset(0, -1).Range("A1").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Paste").Select
        Range("B2").Select
        If Not IsEmpty(ActiveCell.Value) Then
            ActiveCell.Offset(6, 0).Cells.Select
            End If
        If Not IsEmpty(ActiveCell.Value) Then
            ActiveCell.Offset(6, 0).Cells.Select
            End If
        If Not IsEmpty(ActiveCell.Value) Then
            ActiveCell.Offset(6, 0).Cells.Select
            End If
        ActiveSheet.Paste
        Sheets("Paste").Select
        Cells.Select
        Selection.FormatConditions.Delete
        Range("A2").Select
      End If
   Next Cl
End Sub
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Hi. I'm trying to figure out if there's a better way to work this code. I want to copy certain data entries from one sheet into specific cells in another sheet. Right now, it works as long as there are less than 4 data entries to copy. I'd like to have it so that it works for more without having to add more If Not statements. My VBA knowledge is pretty limited, so any insight would be great!


VBA Code:
Sub CopyPasta()

   Sheets("Copy").Select
   Dim Fnd As Range, Cl As Range
 
   Set Fnd = Range("1:1").Find("Notes", , , xlWhole, , , False, , False)
   If Fnd Is Nothing Then
      MsgBox "Notes Not Found"
      Exit Sub
   End If
   For Each Cl In Range(Fnd, Cells(Rows.Count, Fnd.Column).End(xlUp))
      If Cl.Value = "Flip" Then
        ActiveCell.Select
        Cl.Offset(0, -13).Range("A1").Select
        Selection.Copy
        Sheets("Paste").Select
        Range("A2").Select
        If Not IsEmpty(ActiveCell.Value) Then
            ActiveCell.Offset(6, 0).Cells.Select
            End If
        If Not IsEmpty(ActiveCell.Value) Then
            ActiveCell.Offset(6, 0).Cells.Select
            End If
        If Not IsEmpty(ActiveCell.Value) Then
            ActiveCell.Offset(6, 0).Cells.Select
            End If
        ActiveSheet.Paste
        Sheets("Copy").Select
        ActiveCell.Offset(0, -1).Range("A1").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Paste").Select
        Range("B2").Select
        If Not IsEmpty(ActiveCell.Value) Then
            ActiveCell.Offset(6, 0).Cells.Select
            End If
        If Not IsEmpty(ActiveCell.Value) Then
            ActiveCell.Offset(6, 0).Cells.Select
            End If
        If Not IsEmpty(ActiveCell.Value) Then
            ActiveCell.Offset(6, 0).Cells.Select
            End If
        ActiveSheet.Paste
        Sheets("Paste").Select
        Cells.Select
        Selection.FormatConditions.Delete
        Range("A2").Select
      End If
   Next Cl
End Sub
Can you provide a sample sheet that it runs against as well?

For one, you don't need all the .Selects
Also you probably don't even need to copy/paste, but instead identifty the value then tell the paste location that the cell ='s that value

Are you testing to see if it's empty before pasting to it?
 
Last edited:
Upvote 0
Can you provide a sample sheet that it runs against as well?

For one, you don't need all the .Selects
Also you probably don't even need to copy/paste, but instead identifty the value then tell the paste location that the cell ='s that value

Are you testing to see if it's empty before pasting to it?

The left is where I'm getting the info from. The right is where I'm pasting it to. I'm grabbing the run and sample #s based on which are marked as "l" in the Notes column.

I had to do screen grabs because I can't download extra software. I'm sure that this is a very clunky and convoluted way of doing this, but as I mentioned, my knowledge is very limited. I'm trying to work on learning more techniques in general.

I was testing to see if it was empty before pasting into it.

Capture.PNGCapture1.PNG
 
Upvote 0

Forum statistics

Threads
1,215,547
Messages
6,125,461
Members
449,228
Latest member
moaz_cma

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top