Help with Macro to Copy/Paste data below existing data

[fernanpr]

I know there are several threads about this but I couldn't find one to work for me so here goes. Below is the code I created using the Record Macro tool to save all the selected data from one sheet to another but I cannot figure out how to copy/paste new data below the existing data and not over it. I have used the code in red below on other spreadsheets before and this has worked but on this new spreadsheet I'm copying 60 rows of data per run and I think that might be the problem...

Also, I wish to not copy/paste rows that have blank cells and was trying an If statement but couldn't make it work... Otherwise I just end up having to manually delete the rows with blank spaces in them.

What do you recommend?

Sub PCLitesHistorical()
'
' PCLitesHistorical Macro
'
Dim i As Integer
Dim Ans As String


Ans = MsgBox("Are you sure you want to save data?", vbYesNo, "Are you sure?")


If Ans = vbYes Then
Application.ScreenUpdating = False 'This keeps the screen the same while the code executes


Sheets("PCLites Historical").Select
Range("B2:K2").Select

i = 1
Do Until Range("B2").Offset(i, 0).Value = ""
i = i + 1
Loop

Sheets("SMP PCLites").Select
Range("D6:H25,D31:H50,D56:H75").Select
Selection.Copy
Sheets("PCLites Historical").Select
Range("B3").Select
ActiveSheet.Paste

Sheets("SMP PCLites").Select
Range("C4:L4").Select
Selection.Copy
Sheets("PCLites Historical").Select
Range("G3:G22").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("SMP PCLites").Select
Range("C29").Select
Selection.Copy
Sheets("PCLites Historical").Select
Range("G23:G42").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("SMP PCLites").Select
Range("C54").Select
Selection.Copy
Sheets("PCLites Historical").Select
Range("G43:G62").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("SMP PCLites").Select
Range("I6:L25,I31:L50,I56:L75").Select
Selection.Copy
Sheets("PCLites Historical").Select
Range("H3").Select
ActiveSheet.Paste
Range("B3").Select

Application.CutCopyMode = False
Sheets("SMP PCLites").Select
Range("D6").Select

Application.ScreenUpdating = True
ActiveWorkbook.Save

Ans = MsgBox("Data saved.", vbOKOnly, "Thanks.")


End If


End Sub

Appreciate the help in advance.
Thanks.

 

[Max1616]

Hello!

I think there is a better way to write your code all together! I can help you out here if I have a 100% understanding of what you are trying to accomplish.

1) You have a bunch of ranges broken up within your copy/Paste macro (e.g. C4:L4,G43:G62, etc.), Is there a logic to how you are deciding to copy/paste these over? If so what is that logic, or is it always those particular ranges regardless of when you need to run the macro?

2) When you paste the data over are you pasting it to a particular spot on your 2nd sheet or do you just want to paste it into the first empty row on the second sheet?

3) For blank cells, if there is any cell at all in the row you do not want to paste? or do yo only not want to paste completely blank rows?

For #1 if you can list out the logic of how you decide what needs tyo be copied/paste that would be great!

Thanks,

-Max

 

[fernanpr]

Hi Max. Thanks for the quick response.

Okay. Let me help you understand by answering your questions. I hope I can make things clearer.

1) You have a bunch of ranges broken up within your copy/Paste macro (e.g. C4:L4,G43:G62, etc.), Is there a logic to how you are deciding to copy/paste these over? If so what is that logic, or is it always those particular ranges regardless of when you need to run the macro? Those specific ranges or cells will get filled up over and over, once or twice a day; the new data entries will get entered over the existing data once previous data is saved. So the data on those cells continues to be updated and so I want to record that information in another tab but without losing previous data entries.

Okay. One example would be the following:
I want to copy the following cell ranges (excluding the rows with blank cells):
from Sheet 1 always copy from D6:H25,D31:H50,D56:H75
to Sheet 2 B3:F62 with first Macro run

then again from Sheet 1 always copy from D6:H25,D31:H50,D56:H75
to Sheet 2 B63:F122 when Macro is run for the second time (second day)

And so on...

2) When you paste the data over are you pasting it to a particular spot on your 2nd sheet or do you just want to paste it into the first empty row on the second sheet? I just want to paste it to the first empty row on the second sheet.

3) For blank cells, if there is any cell at all in the row you do not want to paste? or do yo only not want to paste completely blank rows? For blank cells, if one cell in the row is blank, I wish to not save that entire row. I actually wanted to make it with the values of a specific column. (For instance, if no Gross Weight was entered in cell H6, do not copy/paste row 6.)

Let me know if you need me to clarify anything else.

Thanks,
Fernando

 

[Max1616]

Great this all makes sense. For your first section (Column D-H) this should move your items to your second sheet in columns B-F:

Sub Fernanpr()


Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Integer
Dim lrow As Integer
Dim Counter As Integer

Set ws1 = Sheets("SMP PCLites")
Set ws2 = Sheets("PCLites Historical")

'Handles D6:D25
For i = 6 To 25
    For Counter = 4 To 8
        If Len(ws1.Cells(i, Counter)) = 0 Then GoTo Nexti1
    Next Counter
    If Len(ws2.Range("B3")) = 0 Then lrow = 3
    If Len(ws2.Range("B3")) <> 0 Then lrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
    ws1.Range(ws1.Cells(i, 4), ws1.Cells(i, 8)).Copy Destination:=ws2.Cells(lrow, 2)
Nexti1:
Next i

'Handles D31:D50
For i = 31 To 50
    For Counter = 4 To 8
        If Len(ws1.Cells(i, Counter)) = 0 Then GoTo Nexti2
    Next Counter
    If Len(ws2.Range("B3")) = 0 Then lrow = 3
    If Len(ws2.Range("B3")) <> 0 Then lrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
    ws1.Range(ws1.Cells(i, 4), ws1.Cells(i, 8)).Copy Destination:=ws2.Cells(lrow, 2)

Nexti2:
Next i
        
'Handles D56:D75
For i = 56 To 75
    For Counter = 4 To 8
        If Len(ws1.Cells(i, Counter)) = 0 Then GoTo Nexti3
    Next Counter
    If Len(ws2.Range("B3")) = 0 Then lrow = 3
    If Len(ws2.Range("B3")) <> 0 Then lrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
    ws1.Range(ws1.Cells(i, 4), ws1.Cells(i, 8)).Copy Destination:=ws2.Cells(lrow, 2)
Nexti3:
Next i
    

End Sub

I'll try and get to the rest tomorrow but I have to head home from work so I wont be able to look at this until the morning.

Sincerely,

-Max

 

[Max1616]

Give this a shot (It pastes normally so if you have any formulas that do not have anchored references they will move with the paste):

Sub Fernanpr()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Integer
Dim lrow As Integer
Dim lrow2 As Integer
Dim Counter As Integer
Dim Srow As Integer

Set ws1 = Sheets("SMP PCLites")
Set ws2 = Sheets("PCLites Historical")

'Handles D6:I25
For i = 6 To 25
    For Counter = 4 To 12
        If Len(ws1.Cells(i, Counter)) = 0 Then GoTo Nexti1
    Next Counter
    If Len(ws2.Range("B3")) = 0 Then lrow = 3
    If Len(ws2.Range("B3")) <> 0 Then lrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
    If i = 6 Then Srow = lrow
    ws1.Range(ws1.Cells(i, 4), ws1.Cells(i, 8)).Copy Destination:=ws2.Cells(lrow, 2)
    ws1.Range(ws1.Cells(i, 9), ws1.Cells(i, 12)).Copy Destination:=ws2.Cells(lrow, 8)
Nexti1:
Next i

'Handles C4
lrow2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row
ws1.Range("C4").Copy Destination:=ws2.Range("G" & Srow, "G" & lrow2)

'Handles D31:I50
For i = 31 To 50
    For Counter = 4 To 12
        If Len(ws1.Cells(i, Counter)) = 0 Then GoTo Nexti2
    Next Counter
    If Len(ws2.Range("B3")) = 0 Then lrow = 3
    If Len(ws2.Range("B3")) <> 0 Then lrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
    If i = 31 Then Srow = lrow
    ws1.Range(ws1.Cells(i, 4), ws1.Cells(i, 8)).Copy Destination:=ws2.Cells(lrow, 2)
    ws1.Range(ws1.Cells(i, 9), ws1.Cells(i, 12)).Copy Destination:=ws2.Cells(lrow, 8)
Nexti2:
Next i
        
'Handles C29
lrow2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row
ws1.Range("C29").Copy Destination:=ws2.Range("G" & Srow, "G" & lrow2)
        
'Handles D56:I75
For i = 56 To 75
    For Counter = 4 To 12
        If Len(ws1.Cells(i, Counter)) = 0 Then GoTo Nexti3
    Next Counter
    If Len(ws2.Range("B3")) = 0 Then lrow = 3
    If Len(ws2.Range("B3")) <> 0 Then lrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
    If i = 56 Then Srow = lrow
    ws1.Range(ws1.Cells(i, 4), ws1.Cells(i, 8)).Copy Destination:=ws2.Cells(lrow, 2)
    ws1.Range(ws1.Cells(i, 9), ws1.Cells(i, 12)).Copy Destination:=ws2.Cells(lrow, 8)
Nexti3:
Next i
    
'Handles C54
lrow2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row
ws1.Range("C54").Copy Destination:=ws2.Range("G" & Srow, "G" & lrow2)


End Sub

This code does the following:
1) Runs through your first chunk of data (D6:H25) and moves all rows to your second sheet (B:F)
2) Runs through your first chunk of data (I6:L25) and moves all rows to your second sheet (H:K)
3) takes C4 and ads it to each row it moved over into your second sheet (G)
4) Then repeats these actions for your 2nd and 3rd data sets (D31:I50,C29 and D56:I75,C54)
5) On the second sheet it will continuously add these new entries to the bottom of whatever is currently in your second sheet.

Let me know if you want any of the code explained or if you have any questions. Also if I missed something please let me know.

Sincerely,
-Max

 

[Max1616]

Also I forgot to mention that it skips any blank cells in your rows. So if you have a blank cell in a row between columns D:L then it will skip that entire row.

Thanks!

 

[fernanpr]

Max,

I am so grateful. Thanks so much for your help. Your code works like a charm.

I did get an error though. It says: Run time error 1004 Method 'Range' of obejct'_Worksheet' failed

So for the code that Handles C4 (and C29): it's showing yellow highlights when I hit Debug.

I have a data set where I only needed to fill cells D56:L66. No other data is filled in the above rows.
Once I run the Macro, it immediately gives me that error.
Then once I disabled those lines from the code. The Macro runs just fine and only copies the filled cells from that range D56:L66.
Can you help with that?

Thanks in advance,
Fernando

 

[Max1616]

Hello Fernando,

I didn't realize that there were instances where all the rows in certain sets could be blank, I have added in a small piece of code to account for this. It's working fine for me:

Sub Fernanpr()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Integer
Dim lrow As Integer
Dim lrow2 As Integer
Dim Counter As Integer
Dim Srow As Integer

Set ws1 = Sheets("SMP PCLites")
Set ws2 = Sheets("PCLites Historical")

'Handles D6:I25
For i = 6 To 25
    For Counter = 4 To 12
        If Len(ws1.Cells(i, Counter)) = 0 Then GoTo Nexti1
    Next Counter
    If Len(ws2.Range("B3")) = 0 Then lrow = 3
    If Len(ws2.Range("B3")) <> 0 Then lrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
    If i = 6 Then Srow = lrow
    ws1.Range(ws1.Cells(i, 4), ws1.Cells(i, 8)).Copy Destination:=ws2.Cells(lrow, 2)
    ws1.Range(ws1.Cells(i, 9), ws1.Cells(i, 12)).Copy Destination:=ws2.Cells(lrow, 8)
Nexti1:
Next i

'Handles C4
lrow2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row
If Srow <> 0 Then ws1.Range("C4").Copy Destination:=ws2.Range("G" & Srow, "G" & lrow2)

'Handles D31:I50
For i = 31 To 50
    For Counter = 4 To 12
        If Len(ws1.Cells(i, Counter)) = 0 Then GoTo Nexti2
    Next Counter
    If Len(ws2.Range("B3")) = 0 Then lrow = 3
    If Len(ws2.Range("B3")) <> 0 Then lrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
    If i = 31 Then Srow = lrow
    ws1.Range(ws1.Cells(i, 4), ws1.Cells(i, 8)).Copy Destination:=ws2.Cells(lrow, 2)
    ws1.Range(ws1.Cells(i, 9), ws1.Cells(i, 12)).Copy Destination:=ws2.Cells(lrow, 8)
Nexti2:
Next i
        
'Handles C29
lrow2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row
If Srow <> 0 Then ws1.Range("C29").Copy Destination:=ws2.Range("G" & Srow, "G" & lrow2)
        
'Handles D56:I75
For i = 56 To 75
    For Counter = 4 To 12
        If Len(ws1.Cells(i, Counter)) = 0 Then GoTo Nexti3
    Next Counter
    If Len(ws2.Range("B3")) = 0 Then lrow = 3
    If Len(ws2.Range("B3")) <> 0 Then lrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
    If i = 56 Then Srow = lrow
    ws1.Range(ws1.Cells(i, 4), ws1.Cells(i, 8)).Copy Destination:=ws2.Cells(lrow, 2)
    ws1.Range(ws1.Cells(i, 9), ws1.Cells(i, 12)).Copy Destination:=ws2.Cells(lrow, 8)
Nexti3:
Next i
    
'Handles C54
lrow2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row
If Srow <> 0 Then ws1.Range("C54").Copy Destination:=ws2.Range("G" & Srow, "G" & lrow2)


End Sub

Let me know if the error persists!

Sincerely,
-Max

 

[Max1616]

I realized that the previous reply had an error if you were missing the middle section but the other two sections were populated. This will fix that:

Sub Fernanpr()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Integer
Dim lrow As Integer
Dim lrow2 As Integer
Dim Counter As Integer
Dim Srow As Integer

Set ws1 = Sheets("SMP PCLites")
Set ws2 = Sheets("PCLites Historical")

'Handles D6:I25
For i = 6 To 25
    For Counter = 4 To 12
        If Len(ws1.Cells(i, Counter)) = 0 Then GoTo Nexti1
    Next Counter
    If Len(ws2.Range("B3")) = 0 Then lrow = 3
    If Len(ws2.Range("B3")) <> 0 Then lrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
    If i = 6 Then Srow = lrow
    ws1.Range(ws1.Cells(i, 4), ws1.Cells(i, 8)).Copy Destination:=ws2.Cells(lrow, 2)
    ws1.Range(ws1.Cells(i, 9), ws1.Cells(i, 12)).Copy Destination:=ws2.Cells(lrow, 8)
Nexti1:
Next i



'Handles C4
lrow2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row
If Srow <> 0 Then ws1.Range("C4").Copy Destination:=ws2.Range("G" & Srow, "G" & lrow2)

Srow = 0

'Handles D31:I50
For i = 31 To 50
    For Counter = 4 To 12
        If Len(ws1.Cells(i, Counter)) = 0 Then GoTo Nexti2
    Next Counter
    If Len(ws2.Range("B3")) = 0 Then lrow = 3
    If Len(ws2.Range("B3")) <> 0 Then lrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
    If i = 31 Then Srow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
    ws1.Range(ws1.Cells(i, 4), ws1.Cells(i, 8)).Copy Destination:=ws2.Cells(lrow, 2)
    ws1.Range(ws1.Cells(i, 9), ws1.Cells(i, 12)).Copy Destination:=ws2.Cells(lrow, 8)
Nexti2:
Next i
        
'Handles C29
lrow2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row
If Srow <> 0 Then ws1.Range("C29").Copy Destination:=ws2.Range("G" & Srow, "G" & lrow2)
        
Srow = 0
        
'Handles D56:I75
For i = 56 To 75
    For Counter = 4 To 12
        If Len(ws1.Cells(i, Counter)) = 0 Then GoTo Nexti3
    Next Counter
    If Len(ws2.Range("B3")) = 0 Then lrow = 3
    If Len(ws2.Range("B3")) <> 0 Then lrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
    If i = 56 Then Srow = lrow
    ws1.Range(ws1.Cells(i, 4), ws1.Cells(i, 8)).Copy Destination:=ws2.Cells(lrow, 2)
    ws1.Range(ws1.Cells(i, 9), ws1.Cells(i, 12)).Copy Destination:=ws2.Cells(lrow, 8)
Nexti3:
Next i
    
'Handles C54
lrow2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row
If Srow <> 0 Then ws1.Range("C54").Copy Destination:=ws2.Range("G" & Srow, "G" & lrow2)


End Sub

 

[fernanpr]

Hi, Max. Again, thanks so much for your help. The new code works great.

I wanted to try and modify it myself a little bit now that I made some changes to the cells just to organize it better for the many users who will be using the file, but I can't seem to update it to show new cell ranges to copy/paste. And now I'm actually making it super easy to create the code but your code is beyond my knowledge.

Could you help one last time?

This is what I'm trying to do: same idea as before just different cell ranges and an added step.

I want to copy/paste the cells from SMP PCLites sheet range C5:L35 onto B3 of second sheet PCLites Historical. Again, skipping rows with blank cells.
Every time new data is entered on sheet one, like your code does, enter it below existing data on sheet two except the rows with blank cells.
That'll be the only data range on this new spreadsheet. Not three ranges like before.

The new step is to copy/paste the value from G36 on sheet 1 onto N3 of the second sheet and on M3 of the second sheet to have the date when the data was entered (or when copy/pasted) which should always be the current date =Today(). Again, after each Macro run, new data should populate below existing data in that second sheet so to not lose previous data. (No need for the blank data lines as these will always be filled after data has been entered on the first sheet.)

Also if possible, since that value is only one per single (unlikely) or multiple entries from the same sheet, can these two new values in M3 and N3 only be on the first row of the new data entered?

For instance, if only 5 rows of non-blank data were filled in the first sheet: copy/paste those 5 rows below existing data in second sheet and also copy/paste the value in G36 onto N3 (with today date in M3) but only in the first row where the new data was added.

I don't know if I make myself clear on that...

Anyways, that will be it for now. Let me know if you have any questions.

I also need to do exactly the same thing on two other tabs titled SMP Seed Drumming (sheet 3) and Seed Drumming Historical (sheet 4) but with a different data range: C6:K55 to B3. (Rows with blank cells skipped too.) And the added step values are now in J56 of sheet 3, to copy/paste to M3 of sheet 4 with date in L3 of sheet 4.

Thanks so much,
Fernando