• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copying data from sheet to sheet overwrites each row

S

Serenutty

New Member
Trying to copy rows from one sheet (from row 8) to another sheet (from row 4) in same workbook. The code copies but overwrites every row and I'm left with one row. Can anyone spot what I've done wrong please? See code below

Note: This piece of code is part of a larger project. I posted a thread yesterday in this site only where I listed everything I want to do in this project. The thread is titled Help with VBA Macros to automate repetitive tasks and produce reports

Code: 
Sub CopyToPAFStatusClient()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet

' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("PM-PA Assignment of Personnel")
Set Target = ActiveWorkbook.Worksheets("Test Page")

Sheets("Test Page").Range("A4:AZ2000").ClearContents

lastrow = Target.Range("F65000").End(xlUp).Row + 1
j = lastrow     ' Start copying to row 4 in target sheet
For Each c In Source.Range("F8:F2000")   ' Do 2000 rows
    If c = "1" Then
       Source.Rows(c.Row).Copy Target.Rows(j).End(xlUp).Offset(1)
       j = lastrow + 1
    End If
Next c
End Sub
 
Try this :

Code: 
Option Explicit

Sub CopyYes()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
    Application.ScreenUpdating = False
   
    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Sheet1")
    Set Target = ActiveWorkbook.Worksheets("Sheet2")
   
    Application.ScreenUpdating = False
    Target.Select

    Sheets("Sheet2").Range("A4:AZ2000").ClearContents

    Source.Select
    j = 4                                                  'Start copying to row 12 in target sheet
   
    For Each c In Source.Range("F8:F2000")                  'Number rows to copy from PIPELINE INPUT sheet
        If c.Value = "1" Then
          Source.Rows(c.Row).Copy Target.Rows(j)
          j = j + 1
        End If
    Next c
   
    Target.Select
    Target.Range("A1").Select                              
   
    Source.Select
    Source.Range("A1").Select
    Application.ScreenUpdating = True
End Sub
 
Hi Logit,

Thanks for your reply, it certainly does copy rows one after the other. Really appreciated.

Could I ask you something else? I've added some lines of code at the beginning to copy and paste special row 4 from Source to Target but it doesn't work and the row is blank - do you know why?

Then at the bottom of the code I added some lines to delete certain columns, this works well or at least it seems to do the trick. But do you have any suggestions on how to group "Test Page" by "Status" column values so that it looks like "Overall PAF Status Client" sheet, separated by a row with a title? I've added a file to show what I mean.

Code: 
Option Explicit

Sub CopyYes()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
    Application.ScreenUpdating = False
   
    ' Change worksheet designations as needed
   Set Source = ActiveWorkbook.Worksheets("PM-PA Assignment of Personnel")
    Set Target = ActiveWorkbook.Worksheets("Test Page")
   
    Sheets("Test Page").Range("A4:AK4").ClearContents

    Sheets("PM-PA Assignment of Personnel").Range("A4:AK4").Copy
    Sheets("Test Page").Range("A4:AK4").PasteSpecial Paste:=xlPasteFormats
   
    Application.ScreenUpdating = False
    Target.Select
       
    Sheets("Test Page").Range("A5:AZ2000").ClearContents

    Source.Select
    j = 5                  'Start copying to row 4 in target sheet
    For Each c In Source.Range("F5:F2000")      'Number rows to copy from PM-PA Assignment of Personnel sheet
       If c.Value = "1" Then
          Source.Rows(c.Row).Copy Target.Rows(j)
          j = j + 1
        End If
    Next c
   
   Target.Range("AA5:AA2000").Value = Range("AA5:AA2000").Value
   
   Target.Range("B5:B2000").Value = Range("B5:B2000").Value

    Target.Columns("AD:AK").Delete
    Target.Columns("P:Y").Delete
    Target.Columns("K:M").Delete
    Target.Columns("F").Delete
    Target.Columns("C:D").Delete

    Target.Select
    Target.Range("A1").Select
       
    Application.ScreenUpdating = True
End Sub
[/COD]
 

Attachments

  • Book7.xlsm
    13 KB · Views: 5
Code: 
Option Explicit

Sub CopyYes()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
    Application.ScreenUpdating = False
   
    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("PM-PA Assignment of Personnel")
    Set Target = ActiveWorkbook.Worksheets("Test Page")
   
    Application.ScreenUpdating = False
    Target.Select

    Sheets("Test Page").Range("A4:AZ2000").ClearContents

    Sheets("PM-PA Assignment of Personnel").Range("A4:AK4").Copy
    Sheets("Test Page").Range("A4:AK4").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
   

    Source.Select
    j = 5                                                 'Start copying to row 4 in target sheet
   
    For Each c In Source.Range("F8:F2000")                  'Number rows to copy from PIPELINE INPUT sheet
       If c.Value = "1" Then
          Source.Rows(c.Row).Copy Target.Rows(j)
          j = j + 1
        End If
    Next c
   
    Sheets("Overall PAF Status Client").Range("A2:N16").Copy
    Sheets("Test Page").Range("A132").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
   
    Target.Select
    Target.Range("A1").Select
   
    Source.Select
    Source.Range("A1").Select
    Application.ScreenUpdating = True
End Sub
 
Hi Logit,

Thank you again for your reply. It copies well but I didn't explain myself very well. What I'm copying from the source needs to be pasted in Target grouped by value of column Z "Status" (Approved, Pending, Rejected, Demob)(all other values can be ignored), and with a heading line such as "PAFs Approved, PAFs Pending, PAFs Rejected, PAFs Demob".
Thanks again
 
I am certain there is a better means of accomplishing the goal but this works :

Code: 
Option Explicit

Sub cpyAll()
    Dim Rws As Long, Rng As Range, ws As Worksheet, sh As Worksheet, c As Range, x As Integer
    Set ws = Worksheets("Test Page")  'specify sheet name here to paste to
    x = 5  'begins pasting in Sheet 1 on row 2
    Application.ScreenUpdating = 0
   
    With Sheets("Test Page")
                    Rws = .Cells(Rows.Count, "B").End(xlUp).Row 'searches Col B all sheets
                    Set Rng = .Range(.Cells(1, "B"), .Cells(Rws, "B"))
                    'For Each c In Rng.Cells
                    '    If c.Value = "APPROVED" Then  'searches for term APPROVED
                    '        c.EntireRow.Copy Destination:=ws.Cells(x, "A")
                    ws.Cells(x, "B").Value = "APPROVED"
                    ws.Cells(x, "B").Font.Bold = True
                    ws.Cells(x, "B").Font.Size = 16
                            x = x + 1
                        'End If
                    'Next c
            End With
   
    For Each sh In Sheets
        If sh.Name = "PM-PA Assignment of Personnel" Then
            With sh
                Rws = .Cells(Rows.Count, "Z").End(xlUp).Row 'searches Col Z all sheets
                Set Rng = .Range(.Cells(1, "Z"), .Cells(Rws, "Z"))
                For Each c In Rng.Cells
                    If c.Value = "APPROVED" Then  'searches for term APPROVED
                        c.EntireRow.Copy Destination:=ws.Cells(x, "A")
                        x = x + 1
                    End If
                Next c
            End With
        End If
    Next sh
   
            With Sheets("Test Page")
                    Rws = .Cells(Rows.Count, "B").End(xlUp).Row 'searches Col B all sheets
                    Set Rng = .Range(.Cells(1, "B"), .Cells(Rws, "B"))
                    'For Each c In Rng.Cells
                    '    If c.Value = "APPROVED" Then  'searches for term APPROVED
                    '        c.EntireRow.Copy Destination:=ws.Cells(x, "A")
                    ws.Cells(x, "B").Value = ""
                        x = x + 1
                    ws.Cells(x, "B").Value = "PENDING"
                    ws.Cells(x, "B").Font.Bold = True
                    ws.Cells(x, "B").Font.Size = 16
                        x = x + 1
                        'End If
                    'Next c
            End With
           
        For Each sh In Sheets
        If sh.Name = "PM-PA Assignment of Personnel" Then
            With sh
                Rws = .Cells(Rows.Count, "Z").End(xlUp).Row 'searches Col Z all sheets
                Set Rng = .Range(.Cells(1, "Z"), .Cells(Rws, "Z"))
                For Each c In Rng.Cells
                    If c.Value = "PENDING" Then  'searches for term APPROVED
                        c.EntireRow.Copy Destination:=ws.Cells(x, "A")
                        x = x + 1
                    End If
                Next c
            End With
        End If
    Next sh
   
    With Sheets("Test Page")
                    Rws = .Cells(Rows.Count, "B").End(xlUp).Row 'searches Col B all sheets
                    Set Rng = .Range(.Cells(1, "B"), .Cells(Rws, "B"))
                    'For Each c In Rng.Cells
                    '    If c.Value = "APPROVED" Then  'searches for term APPROVED
                    '        c.EntireRow.Copy Destination:=ws.Cells(x, "A")
                    ws.Cells(x, "B").Value = ""
                        x = x + 1
                    ws.Cells(x, "B").Value = "REJECTED"
                    ws.Cells(x, "B").Font.Bold = True
                    ws.Cells(x, "B").Font.Size = 16
                        x = x + 1
                        'End If
                    'Next c
            End With
           
        For Each sh In Sheets
        If sh.Name = "PM-PA Assignment of Personnel" Then
            With sh
                Rws = .Cells(Rows.Count, "Z").End(xlUp).Row 'searches Col Z all sheets
                Set Rng = .Range(.Cells(1, "Z"), .Cells(Rws, "Z"))
                For Each c In Rng.Cells
                    If c.Value = "REJECTED" Then  'searches for term APPROVED
                        c.EntireRow.Copy Destination:=ws.Cells(x, "A")
                        x = x + 1
                    End If
                Next c
            End With
        End If
    Next sh
   
    With Sheets("Test Page")
                    Rws = .Cells(Rows.Count, "B").End(xlUp).Row 'searches Col B all sheets
                    Set Rng = .Range(.Cells(1, "B"), .Cells(Rws, "B"))
                    'For Each c In Rng.Cells
                    '    If c.Value = "APPROVED" Then  'searches for term APPROVED
                    '        c.EntireRow.Copy Destination:=ws.Cells(x, "A")
                    ws.Cells(x, "B").Value = ""
                        x = x + 1
                    ws.Cells(x, "B").Value = "DEMOB"
                    ws.Cells(x, "B").Font.Bold = True
                    ws.Cells(x, "B").Font.Size = 16
                        x = x + 1
                        'End If
                    'Next c
            End With
           
        For Each sh In Sheets
        If sh.Name = "PM-PA Assignment of Personnel" Then
            With sh
                Rws = .Cells(Rows.Count, "Z").End(xlUp).Row 'searches Col Z all sheets
                Set Rng = .Range(.Cells(1, "Z"), .Cells(Rws, "Z"))
                For Each c In Rng.Cells
                    If c.Value = "DEMOB" Then  'searches for term APPROVED
                        c.EntireRow.Copy Destination:=ws.Cells(x, "A")
                        x = x + 1
                    End If
                Next c
            End With
        End If
    Next sh
End Sub
 

Attachments

  • TEST_PAF_Reg-V0 - VER 7.xlsm
    95.7 KB · Views: 3
Logit, You are a star!! It's taking me a while to kind of grasp how it works and I don't think I understand it completely but I will persevere until I get it. Doesn't matter if it there's a better way to do this. The important thing is that it works. Thank you. It's not a massive project and will have a maximum of 2000 records. I only do it because currently my company have been doing all these updates manually on every tab and I think this leads to too many errors, waste of time and boredom. I need to make my life simpler!
I have more things to expand on this project would you like to help or shall I post it in the general blog?
My next step is to copy certain columns from different tabs and paste them in another sheet called "Miscellaneous PAF Client" and grouped by values of Z column again. It is important to only copy those columns not the whole row because each PAF has different column headings, so Column Z=Status might be in another column in another sheet. My file attached earlier doesn't have these miscellaneous sheets but it has a sample of how sheet "Miscellaneous PAF Client" should look. I can make these required columns to fit the same columns on each tab but that would be a job in itself.
I suppose to accomplish this I could copy the data from all source sheets into target sheet and then try to apply your previous sorting code?
Thanks
Sonia
PS- I hope you are having a nice weekend
 
You are welcome.

I have more things to expand on this project would you like to help or shall I post it in the general blog?
Click to expand...

Best to start another thread.

If your project is requiring copying repetitive data from more than one sheet, it is always best, if possible, to have each sheet designed the same. Makes it alot easier to locate the data then process the find. HOWEVER, don't redesign your project because of it until it is determined to be a true need.
 
Cool. Thanks so much for the grouping though, I would have never come up with that on my own. Before I start the new thread I will do other things with the same report like delete columns, copy into a new workbook and hopefully email it. Once I understand the grouping completely, I'll try it first with one of the other sheets and add up sheets if it works.
Thank you so much
 
You must log in or register to reply here.
Back
Top