VBA Help on Data Copy

[elgre]

Hi everyone,

I have a question about the VBA code I wrote below.

First of all, a brief summary of what I try to achieve:
I have 2 excel sheets, sheet1 and sheet2. The sheet1 has the data in B:AW and the sheet2 has a data in the M:W. I wanted to create a VBA code that copies the data in B:I and M:O starting from 7th row from sheet1 to B:K of sheet2 starting from again 7th row by also keeping the formatting same. I also set the last row to be copied the row above the sheet includes "Comment sheet" in column B. So for instance, lets assume that B1200 has "Comment sheets" in the cell so the code takes the data in B7:I1199 and M7:O1199 from sheet 1 and copies to sheet2 B7:K1199.
As a next step, I also wanted to capture all the updates in copied columns of sheet1 in sheet2 automatically. The code, apparently, does the job and every time I press run, it captures the update. I will probably assign a button to let the users update sheet2 according to the updates sheet1.

But I have 2 problems:
1- When I add a new row in sheet1 and run the code, the new row in sheet2 is added for only columns B:K. However, as I said above, I have more data in M:W which is not depending on any data in sheet1. So when I add a new row in sheet1, I want this row to be added in sheet2 not only for B:K but also M:W (which means a new row for B:W).
2- When I add a new row in sheet1, run the code, delete the row in sheet1 and run the code, it does not move the last row up in sheet2, instead keeps the last row in sheet2 and duplicates this row above. Lets assume our last row is 1199 and B1199 is "AAA", so when I add a new row in sheet1, run the code, B1199 moves to B1200 as expected but when I delete the row in sheet1 and run the code, B1200 stays as "AAA" and B1199 becomes "AAA" too.

Unfortunately, I cannot share the file due to confidentiality but I hope the description above is clear enough. I am sharing the code below as well, which I hope will give a better idea.

I am quite new to VBA and my knowledge is very limited so I am also open to any suggestions that makes the code more readable and tidy.

Many thanks in advance.

Sub CopyPartialDataToSheet2()
    'Declare variables
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range

    'Set worksheets
    Set ws1 = ThisWorkbook.Sheets("sheet1")
    Set ws2 = ThisWorkbook.Sheets("sheet2")

    'Find last row in sheet1 and sheet2
    lastRow1 = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Row

    'Find last row to be copied in sheet1
    Do While ws1.Cells(lastRow1, "C").Value <> "Comment Sheets"
        lastRow1 = lastRow1 - 1
    Loop
    lastRow1 = lastRow1 - 5

    'Print debug information
    Debug.Print "lastRow1: " & lastRow1 & ", lastRow2: " & lastRow2
   
    'Set ranges to be copied
    Set rng1 = ws1.Range("C7:I" & lastRow1)
    Set rng2 = ws1.Range("M7:O" & lastRow1)

    'Copy ranges from sheet1 to sheet2
    rng1.Copy ws2.Range("B7")
    rng2.Copy ws2.Range("B7").Offset(0, rng1.Columns.Count)

    'Adjust column widths in sheet2 to match those in sheet1
    For i = 1 To rng1.Columns.Count
        ws2.Columns(i).ColumnWidth = ws1.Columns(i).ColumnWidth
    Next i
    For i = 1 To rng2.Columns.Count
        ws2.Columns(i + rng1.Columns.Count).ColumnWidth = ws1.Columns(i + rng1.Columns.Count).ColumnWidth
    Next i
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    'Declare variables
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim rngHeights As Range
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim i As Long

    'Exit the sub if the change was not made in sheet1
    If Target.Parent.Name <> "sheet1" Then Exit Sub

    'Set worksheets
    Set ws1 = ThisWorkbook.Sheets("sheet1")
    Set ws2 = ThisWorkbook.Sheets("sheet2")

    'Find last row in sheet1 and sheet2
    lastRow1 = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Row

    'Find last row to be copied in sheet1
    Do While ws1.Cells(lastRow1, "B").Value <> "Comment Sheets"
        lastRow1 = lastRow1 - 1
    Loop
    lastRow1 = lastRow1 - 5

    'Print debug information
    Debug.Print "lastRow1: " & lastRow1 & ", lastRow2: " & lastRow2

    'Set ranges to be copied
    Set rng1 = ws1.Range("B7:K" & lastRow1)
    Set rng2 = ws1.Range("M7:O" & lastRow1)
    Set rng3 = ws2.Range("M7:W" & lastRow1)

    'Copy data and row heights from sheet1 to sheet2
    rng1.Copy ws2.Range("B7")
    rng2.Copy ws2.Range("B7").Offset(0, rng1.Columns.Count)
    If lastRow1 > lastRow2 Then
        ws2.Range("B" & lastRow2 + 1 & ":K" & lastRow1).Insert Shift:=xlDown
        rng3.Copy ws2.Range("B" & lastRow2 + 1).Offset(0, rng1.Columns.Count + rng2.Columns.Count)
        Set rngHeights = ws1.Range("B" & lastRow2 + 1 & ":B" & lastRow1)
        For i = 1 To rngHeights.Rows.Count
            ws2.Rows(lastRow2 + i).RowHeight = rngHeights.Rows(i).RowHeight
        Next i
    End If
End Sub

 

[elgre]

The question is still live. Any help would be very appreciated. Thanks!

 

[elgre]

A last push for a response. Once again, any help would be really appreciated. Many thanks!

 

[Alex Blakenburg]

Trying to sync 2 sheets like this sounds like its destined to fail.
Your text says you are copying B:I & M:O which is 11 columns to B:K which is only 10 columns
Your actual worksheet event code is copying B:K & M:O which is 13 columns, this would take sheet 2 to columns B:N, yet rng3 runs from column M

Your text says it is to copy down to 1 row above the text in column B "Comment Sheets" but code then subtracts 5 from that number.

The worksheet event code is different to the CopyPartialDataToSheet2 code, which are you using ?

How should the columns to the right on sheet 2 relate to the columns being copied in ?

I think you will need to give some visibility over the 2 sheets with a before and after view