Copy a cell value from one worksheet to the first blank cell in column C on another worksheet & paste the value all the way down to the last used row

[Bailey9]

Hello
It has been a number of years since I have used VBA, and just can't figure out this SIMPLE solution.

What I have so far is:
Code

1. ''''''''''''''''''''
2. 'COPY THE FILE TYPES
3. ''''''''''''''''''''
4. Sheets("DO NOT DELETE").Select
5. Range("A8").Select
6. Selection.Copy
7. Sheets("SUMMARY SHEET").Activate
8. ActiveSheet.Range("C6000").Select
9. ActiveSheet.Range("C6000").End(xlUp).Select
10. ActiveCell.Offset(1, 0).Select
11. ActiveSheet.PasteSpecial
12. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
13. :=False, Transpose:=False

 

[Bailey9]

There are TWO different fields. I want to copy from the A8 cell in the DO NOT DELETE worksheet, into the SUMMARY worksheet into the last cell used in Column C, based on the LAST USED CELL in Column A.

 

[Bailey9]

I haven't done coding in 8 years, and I was always a beginner. An ex-employer asked me to make some changes, and I really hate to disappoint. I'm retired now,, so I don't do it anymore, but I really loved it as it was such a challenging puzzle. Thank you for your advice.

 

[HaHoBe]

Hi Bailey9,

let´s see if we can handle the problem in the forum as it might be of interest for other users as well.

I worked on the code, and you should copy and paste it (on a copy of the original data) and see if it works. I got rid of all the Selects and Copy&Paste things. Basicly there is no need to change worksheets to get data from or to them. There is a small error handling included which will end the procedure and display some information in the Immediate Window. Due to my setting the descritption is in german and it looks like this (I changed the name of the first sheet so VBA can´t find it). This will avoid anybody to have a look in the IDE and not knowing what to do with whatever error was thrown up.

====
Error occurred at 05.07.2021 09:46:40
lngPassed shows a value of: 0
9
Index außerhalb des gültigen Bereichs
====

The code:

Sub Summarize_mod()
Dim btn As Long 'bottom row
Dim Rght As Long 'far right column
Dim LastRow As Long
Dim lngPassed As Long

On Error GoTo Summarize_mod_Error
'###Turn the  flickering of the screen off
Application.ScreenUpdating = False

'###Variable for Error-Handling to show what to look at when an error occurs
lngPassed = 0
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'CLEAR ALL DATA CLEAR ALL DATA CLEAR ALL DATA
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'###Using a with-clause enables us to work on any range of the sheet without activating that sheet
With Sheets("SUMMARY SHEET")
' If AutoFiler is on, Turn Off '????????????
  If .AutoFilterMode Then
    .AutoFilterMode = False
  End If

' Clear the Summary Sheet items, except headers
'###Instead of using the macro.recorder syntax we build a range by using Cells inside the range to inform which should be used
  .Range(.Range("A2"), .Range("A2").SpecialCells(xlLastCell)).Delete Shift:=xlUp
End With

lngPassed = 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'COPY THE ANNUAL REPORTS DATA COPY THE ANNUAL REPORTS DATA
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''
'COPY THE STATES DATA
''''''''''''''''''''''''''''

' Select Annual Reports & Copy States
With Sheets("Annual Report")

'Find the last row in column A
'###shorten the code
  btn = .Range("A6000").End(xlUp).Row

'Activate cell A
'###shorten the code
  Rght = .Range("A1").Column

'paste the values over
'###we search for the last used row on Sheet SUMMARY SHEET, go down a row, build an area of rows from the bottom row - 3
'###we havbe to add 1 to get the proper number of rows, and 1 column
  Sheets("SUMMARY SHEET").Range("A6000").End(xlUp).Offset(1, 0).Resize(btn - 2, 1).Value = _
    .Range(.Cells(3, Rght), .Cells(btn, Rght)).Value
End With
lngPassed = 2

''''''''''''''''''''
'COPY THE DUE DATES
''''''''''''''''''''

' Select Annual Reports & Copy Due Daates
With Sheets("Annual Report")

'Find the last row in column A
  btn = .Range("A6000").End(xlUp).Row

'Activate cell J
  Rght = .Range("J1").Column

'paste the values over
  Sheets("SUMMARY SHEET").Range("B6000").End(xlUp).Offset(1, 0).Resize(btn - 2, 1).Value = _
    .Range(.Cells(3, Rght), .Cells(btn, Rght)).Value
End With
lngPassed = 3
   
''''''''''''''''''''
'COPY THE FILE TYPES
''''''''''''''''''''
With Sheets("SUMMARY SHEET")
  .Range("C2").Value = Sheets("DO NOT DELETE").Range("A7").Value
  LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
  .Range("C2").Copy .Range("C3:C" & LastRow)
End With
lngPassed = 4

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'COPY THE FRANCHISE REPORTS DATA COPY THE FRANCHISE REPORTS DATA
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''
'COPY THE STATES DATA
''''''''''''''''''''''''''''

' Select Annual Reports & Copy States
With Sheets("Franchise")

'Find the last row in column A
  btn = .Range("A6000").End(xlUp).Row

'Activate cell A
  Rght = .Range("A1").Column

'Move down to row 3 in column A
  Sheets("SUMMARY SHEET").Range("A6000").End(xlUp).Offset(1, 0).Resize(btn - 2, 1).Value = _
      .Range(Cells(3, Rght), Cells(btn, Rght)).Value
End With
lngPassed = 5

''''''''''''''''''''
'COPY THE DUE DATES
''''''''''''''''''''

' Select Annual Reports & Copy Due Daates
With Sheets("Franchise")

'Find the last row in column A
  btn = .Range("A6000").End(xlUp).Row

'Activate cell J
  Rght = .Range("J1").Column

'paste the values over
  Sheets("SUMMARY SHEET").Range("B6000").End(xlUp).Offset(1, 0).Resize(btn - 2, 1).Value = _
    .Range(.Cells(3, Rght), .Cells(btn, Rght)).Value
End With
lngPassed = 6

''''''''''''''''''''
'COPY THE FILE TYPES
''''''''''''''''''''
Sheets("SUMMARY SHEET").Range("C6000").End(xlUp).Offset(1, 0).Value = Sheets("DO NOT DELETE").Range("A8").Value
lngPassed = 7

Application.ScreenUpdating = True

On Error GoTo 0
Exit Sub

Summarize_mod_Error:

Debug.Print "Error occurred at " & Now
Debug.Print "lngPassed shows a value of: " & lngPassed
Debug.Print Err.Number
Debug.Print Err.Description

End Sub[

Please try and come back - I´ll have an eye on this thread.

Ciao,
Holger

 

[Bailey9]

Well, sadly not so much. It runs, but not so far as I got through. Can I send you my worksheet.?

 

[HaHoBe]

Hi Bailey9,

what´s the content of the immediate window?

Ciao,
Holger

 

[Bailey9]

I really feel like an idiot. It ran without an error. You tried with so much time. I thank you. I'm sorry, I'm clearly doing something wrong.

I have to go to bed. YOU TOO! I thank you.

 

[HaHoBe]

Hi Bailey9,

please look at the code and run it again after a rest. If that took care of your request please mark the thread as solved.

Ciao,
Holger

 

[Fluff]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Copy a cell value from one worksheet to the first blank cell in column C on another worksheet & paste the value all the way down to the last used row value in Column A - OzGrid Free Excel/VBA Help Forum
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[Bailey9]

Hi Ciao.
Error occurred at 7/5/2021 11:00:30 AM
lngPassed shows a value of: 4
1004
Application-defined or object-defined error

It is copying A8 and pasting to the summary sheet, but I need it to copy the value all the way down to the last used cell in Column A (which is row 109)

 

[HaHoBe]

Hi Bailey9,

instead of

'Move down to row 3 in column A
  Sheets("SUMMARY SHEET").Range("A6000").End(xlUp).Offset(1, 0).Resize(btn - 2, 1).Value = _
      .Range(Cells(3, rght), Cells(btn, rght)).Value

please use

'Move down to row 3 in column A
  Sheets("SUMMARY SHEET").Range("A6000").End(xlUp).Offset(1, 0).Resize(btn - 2, 1).Value = _
      .Range(.Cells(3, rght), .Cells(btn, rght)).Value

I missed the dots before Cells on that line.

Ciao,
Holger