Copy data from multiple sheets

**bjohnsonac** · 08-26-2009, 01:29 PM

I am using the following code to copy data from multiple tabs to a summary tab - it is only supposed to copy the data in the rows if the cells in Column A have data in them, its working, but for some reason it is copying the data in columns Y and Z for four extra rows even though there is no data in column A for those rows.....driving me crazy! I am attaching a sample of the workbook here as well - hoping someone can figure out what I have coded wrong

I am working in Office 2007.

Sub SumData()
'
' SummarizeData from Timesheets
'
    Sheets("Jorge Montoya").Select
    Range("A9").Select
    Set r = Range("A9:A27")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "") > 0 Then
        ActiveCell.Range("A1:Z1").Select
        Selection.Copy
    Sheets("Total by Job_Code").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Jorge Montoya").Select
    
    ActiveCell.Offset(1, 0).Select
    Next n
    
    Range("A9").Select
    
      
    Sheets("Felipe Estrada").Select
    Range("A9").Select
    Set r = Range("A9:A27")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "") > 0 Then
        ActiveCell.Range("A1:Z1").Select
        Selection.Copy
    Sheets("Total by Job_Code").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Felipe Estrada").Select
    
    ActiveCell.Offset(1, 0).Select
    Next n
    
    Range("A9").Select
    
    
    Sheets("Kimberly Garcia").Select
    Range("A9").Select
    Set r = Range("A9:A27")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "") > 0 Then
        ActiveCell.Range("A1:Z1").Select
        Selection.Copy
    Sheets("Total by Job_Code").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Kimberly Garcia").Select
    
    ActiveCell.Offset(1, 0).Select
    Next n
    
    Range("A9").Select
    
End Sub

There will end up being about 30 different tabs that it will need to copy from, but the attachment I am including only has 3.

Thank you in advance for any help!

**ravishankar** · 08-26-2009, 02:10 PM

Hi
NO attachments!
try these codes

Sub SumData()
Dim a As Long, b As Long, d As Long, x As Long
d = 2
    For a = 1 To Sheets.Count
        If Worksheets(a).Name <> "Total by Job_Code" Then
        x = Worksheets(a).Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Total by Job_Code").Cells(d, 1) = Worksheets(a).Name
            For b = 9 To x
                If Worksheets(a).Cells(a, 1) <> "" Then
                Worksheets(a).Range("A" & b & ":Z" & b).Copy
                Worksheets("Total by Job_Code").Cells(d, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=True, Transpose:=False
                d = d + 1
                End If
            Next b
        d = d + 1
        End If
    Next a
End Sub

Ravi

**bjohnsonac** · 08-26-2009, 07:29 PM

I tried that code and it only copied the name of the person over - I am trying to attach my sample workbook again

**ravishankar** · 08-27-2009, 12:32 AM

Hi
try the sumdata from module2 in the attached file
Ravi

**bjohnsonac** · 08-27-2009, 07:28 AM

That works great thank you - one issue though...I don't want the names of the people transferred over, but can't figure out from your code what part is telling it to do that....

**bjohnsonac** · 08-27-2009, 07:34 AM

I figured it out

Thank you again for all your help! One of these days I will figure out all the fancy code and be able to reduce my multi-page macros down to a short one like you supplied me!