Assistance with VBA code to copy& paste value between 2 sheets.

[ebeyert]

I have the following VBA code and everything goes well except for copying the data from sheet: daily log to sheet backlog.

Sheet Daily Log:
In column C (from row 10) I can make a choice and 1 of the choices is "new".
Sheet Backlog: in this sheet I have a row with the name "Daily Log *".

Action:
If there is a row in the sheet Daily Log with the text "new" then a row must be added in the sheet Backlog under "Daily Log *". Row 10 is the template of the row that must then be added.

If the row is added in the sheet Backlog then the data of the row, range column B to Column M in the sheet Daily log where new is stated must be copied and placed in the new row, but then in the range Column C to Column N.
Only the value must then be copied.

The VBA code below works fine until the creation of the new row in the sheet Backlog. But copying the data from the sheet daily log does not work. Whatever I change. it still does not work. Who can help me?

Sub AddRowsAndCopyDataToBacklogFinal()

Dim wsDailyLog As Worksheet, wsBacklog As Worksheet

Dim lastRow As Long, newCount As Long, insertRow As Long

Dim foundCell As Range

Dim dailyLogRow As Long, backlogRow As Long

Dim srcRange As Range, destRange As Range



' Speed up processing

Application.ScreenUpdating = False

Application.EnableEvents = False

Application.Calculation = xlCalculationManual



' Set worksheets

On Error Resume Next

Set wsDailyLog = ThisWorkbook.Sheets("Daily log")

Set wsBacklog = ThisWorkbook.Sheets("backlog")

On Error GoTo 0



' Ensure worksheets exist

If wsDailyLog Is Nothing Or wsBacklog Is Nothing Then

MsgBox "One or both worksheets are missing. Check sheet names.", vbCritical

GoTo Cleanup

End If



' Find last used row in column B of "Daily log"

lastRow = wsDailyLog.Cells(wsDailyLog.Rows.Count, 2).End(xlUp).Row



' Count "new" occurrences in column C from row 10 onwards

newCount = Application.WorksheetFunction.CountIf(wsDailyLog.Range("C10:C" & lastRow), "new")



' Exit if no "new" statuses are found

If newCount = 0 Then

MsgBox "No rows with 'new' found in 'Daily log' column C from row 10 onward.", vbExclamation

GoTo Cleanup

End If



' Find the first occurrence of "Daily Log *" in "backlog" column C

Set foundCell = wsBacklog.Range("C:C").Find(What:="Daily Log *", LookAt:=xlPart, MatchCase:=False)



' Ensure foundCell is valid

If foundCell Is Nothing Then

MsgBox "No row with 'Daily Log *' found in column C of 'backlog'.", vbExclamation

GoTo Cleanup

End If



insertRow = foundCell.Row + 1 ' Insert below this row



' Ensure row 10 in "backlog" is not empty (it must be a template)

If Application.WorksheetFunction.CountA(wsBacklog.Rows(10)) = 0 Then

MsgBox "Row 10 in 'backlog' is empty and may not be a valid template.", vbExclamation

GoTo Cleanup

End If



' Insert new rows first

wsBacklog.Rows(insertRow).Resize(newCount).Insert Shift:=xlDown



' Copy row 10 as a template to the newly inserted rows

wsBacklog.Rows(10).Copy

wsBacklog.Rows(insertRow).Resize(newCount).PasteSpecial Paste:=xlPasteFormats

Application.CutCopyMode = False



' Copy values from Daily Log (B:M) to Backlog (C:N)

backlogRow = insertRow ' Start pasting at the first inserted row



For dailyLogRow = 10 To lastRow ' Start from row 10 in "Daily Log"

If wsDailyLog.Cells(dailyLogRow, 3).Value = "new" Then

' Copy range B:M from Daily Log

Set srcRange = wsDailyLog.Range("B" & dailyLogRow & ":M" & dailyLogRow)

' Paste into range C:N in Backlog

Set destRange = wsBacklog.Range("C" & backlogRow & ":N" & backlogRow)



' Paste values only

destRange.Value = srcRange.Value



' Move to the next row in Backlog

backlogRow = backlogRow + 1

End If

Next dailyLogRow



MsgBox newCount & " rows successfully added and data copied to 'backlog'.", vbInformation



Cleanup:

Application.ScreenUpdating = True

Application.EnableEvents = True

Application.Calculation = xlCalculationAutomatic

End Sub

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach the desired selected data range on each sheet (not pictures) of your data. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[ebeyert]

Mumps, thanks. I put the sheet on google drive: Excel - Google Drive

 

[NoSparks]

try

        If LCase(wsDailyLog.Cells(dailyLogRow, 3).Value) = "new" Then

 

[ebeyert]

try

        If LCase(wsDailyLog.Cells(dailyLogRow, 3).Value) = "new" Then

NoSparks, Thanks... Its working

 

[mumps]

You can try a different approach to see if it works for you. Currently, your macro processes all the "New" rows at once when you run the macro. The approach I'm suggesting, automatically processes each row independently as you select "New" from the drop down in column C. You don't have to run the macro manually. You must enter all the data in column B and columns D to M before selecting "New" in column C which must be done last. When you select "New", the data in that row will automatically be copied to the Backlog sheet.

Copy and paste the macro below into the worksheet code module. Do the following: right click the tab name for your Daily Log sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Select "New" in any cell in column C.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 3 Then Exit Sub
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    Dim desWS As Worksheet, foundCell As Range, lastrow As Long
    lastrow = Cells(Rows.Count, 2).End(xlUp).Row
    Set desWS = Sheets("Backlog")
    Set foundCell = desWS.Range("C:C").Find(What:="Daily Log", LookAt:=xlPart, MatchCase:=False)
    If foundCell Is Nothing Then
        MsgBox "No row with 'Daily Log *' found in column C of 'Backlog'.", vbExclamation
        GoTo Cleanup
    End If
    If Not Evaluate("isref('Daily Log'!A1)") Or Not Evaluate("isref('Backlog'!A1)") Then
        MsgBox "One or both worksheets are missing. Check sheet names.", vbCritical
        GoTo Cleanup
    End If
    If WorksheetFunction.CountIf(Range("C10:C" & lastrow), "New") = 0 Then
        MsgBox "No rows with 'New' found in 'Daily log' column C from row 10 onward.", vbExclamation
        GoTo Cleanup
    End If
    If WorksheetFunction.CountA(desWS.Rows(10)) = 0 Then
        MsgBox "Row 10 in 'Backlog' is empty and may not be a valid template.", vbExclamation
        GoTo Cleanup
    End If
    With desWS
        .Rows(foundCell.Row + 1).Insert Shift:=xlDown
        .Rows(10).Copy
        .Rows(foundCell.Row + 1).PasteSpecial Paste:=xlPasteFormats
        Range("B" & Target.Row & ":M" & Target.Row).Copy .Range("C" & foundCell.Row + 1)
     End With
Cleanup:
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

 

[ebeyert]

You can try a different approach to see if it works for you. Currently, your macro processes all the "New" rows at once when you run the macro. The approach I'm suggesting, automatically processes each row independently as you select "New" from the drop down in column C. You don't have to run the macro manually. You must enter all the data in column B and columns D to M before selecting "New" in column C which must be done last. When you select "New", the data in that row will automatically be copied to the Backlog sheet.

Copy and paste the macro below into the worksheet code module. Do the following: right click the tab name for your Daily Log sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Select "New" in any cell in column C.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 3 Then Exit Sub
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    Dim desWS As Worksheet, foundCell As Range, lastrow As Long
    lastrow = Cells(Rows.Count, 2).End(xlUp).Row
    Set desWS = Sheets("Backlog")
    Set foundCell = desWS.Range("C:C").Find(What:="Daily Log", LookAt:=xlPart, MatchCase:=False)
    If foundCell Is Nothing Then
        MsgBox "No row with 'Daily Log *' found in column C of 'Backlog'.", vbExclamation
        GoTo Cleanup
    End If
    If Not Evaluate("isref('Daily Log'!A1)") Or Not Evaluate("isref('Backlog'!A1)") Then
        MsgBox "One or both worksheets are missing. Check sheet names.", vbCritical
        GoTo Cleanup
    End If
    If WorksheetFunction.CountIf(Range("C10:C" & lastrow), "New") = 0 Then
        MsgBox "No rows with 'New' found in 'Daily log' column C from row 10 onward.", vbExclamation
        GoTo Cleanup
    End If
    If WorksheetFunction.CountA(desWS.Rows(10)) = 0 Then
        MsgBox "Row 10 in 'Backlog' is empty and may not be a valid template.", vbExclamation
        GoTo Cleanup
    End If
    With desWS
        .Rows(foundCell.Row + 1).Insert Shift:=xlDown
        .Rows(10).Copy
        .Rows(foundCell.Row + 1).PasteSpecial Paste:=xlPasteFormats
        Range("B" & Target.Row & ":M" & Target.Row).Copy .Range("C" & foundCell.Row + 1)
     End With
Cleanup:
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

Mumps, Thanks, this works as well.​

 

[mumps]

You are very welcome.