Code to copy info from all but one sheet

[Briscoe]

I need to take information from all sheet and copy certain feild data into my Summary sheet (first sheet). So in escence, I need the code to run on all sheets except the first titled 'Summary'. There will be a varying number of sheets following the Summary tab. Thank you in advance!

 

[SkipVought]

Hi,

Really need more info than you have given, but it could look something like theis...

set wsSummary = worksheets("Summary")
for each sh in worksheets
  with sh
    if sh.name <> wssummary.name then
      select case .name
        case &quot;Sheet1&quot;
          range(.cells(), .cells()).copy _
            destination:=wssummary.range()
        case &quot;Sheet2&quot;
          range(.cells(), .cells()).copy _
            destination:=wssummary.range()
      end select
    end if
  end with
next

Let me know more.

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[Chattin]

Well a similar approach to what SkipVought said in thread thread707-680302 would work. You could use the macro recorder to generate some of your code but no criteria would be specified. How do you want to do this as you say 'certain field data'?

 

[Briscoe]

Sorry I didn't include enough info. Every sheet, except Summary, has the same format. The same group of cells from each sheet(except Summary) need to be copied and inserted into the Summary sheet, one group of cells on top of the other. The code needs to start with the second sheet and progressively move through the rest of the sheets until it reaches the last sheet which is undetermined and varies. In addition, all sheet names will vary, except for the Summary sheet. I hope this gives a little more insight. Thank you.

 

[SkipVought]

Brisco,

What is the source range on each sheet.

What is the target range (single cell range) on the summary sheet for each other sheet?

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[Briscoe]

Skip,

The source range on each sheet is the range B6:B12.

The data will then need to be pasted using paste special to make it transpose into range B9:H9. After it pastes it, it will need to either insert a row so that the next sheets data can be inserted in the same place on the summary sheet, or it will need to paste it below the data from the first sheet.

Hope this helps.

Thanks!!

 

[SkipVought]

    Set wsSummary = Worksheets("Summary")
    For Each sh In Worksheets
      With sh
        If sh.Name <> wsSummary.Name Then
          With wsSummary.Range(B9)
            If .Value = &quot;&quot; Then
              r = .Row
            Else
              r = w.End(xlDown).Row
            End If
          End With
          Range(.Cells(6, &quot;B&quot;), .Cells(12, &quot;B&quot;)).Copy
          wsSummary.Cells(r, &quot;B&quot;).PasteSpecial _
            Paste:=xlAll, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=True
        End If
      End With
    Next

Hope this helps


Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[Briscoe]

I got an error on this part of the code:

With wsSummary.Range(B9)

The error was a Run-time error '1004':
Application-defined or object -defined error

 

[Briscoe]

Sorry...I got that part fixed by adding the quotation marks around B9, but now I have another error

r = w.End(xlDown).Row

Gives me an error of Run-Time Error 424:
It says object required.

It copied the information from the first sheet and pasted it, but then it gave me the error.

Thanks for your help.

 

[SkipVought]

sorry. I had a couple of problems ...-

    Set wsSummary = Worksheets("Summary")
    For Each sh In Worksheets
      With sh
        If sh.Name <> wsSummary.Name Then
          With wsSummary.Range(&quot;B9&quot;)
            If .Value = &quot;&quot; Then
              r = .Row
            Else
              If .Offset(1, 0).Value = &quot;&quot; Then
                r = .Row + 1
              Else
                r = .End(xlDown).Row + 1
              End If
            End If
          End With
          Range(.Cells(6, &quot;B&quot;), .Cells(12, &quot;B&quot;)).Copy
          wsSummary.Cells(r, &quot;B&quot;).PasteSpecial _
            Paste:=xlAll, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=True
        End If
      End With
    Next

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[Briscoe]

Thank you very much for your help, but I have one last question..

It turns out that there is one other cell on each sheet that will need to be copied to the summary sheet. This cell is not located next to the other cells. So, I will need the contents of A1 copied to cell A9 in the summary sheet, and then I will need it to copy the range B6:B12 to the range B9:H9 on the summary sheet. Then it will have to do the same as before by running through all of the sheets and doing the same task just one row below the previous one.

Let me know if you need more information.

Thanks again!!!!

 

[SkipVought]

Briscoe,

You ought to be able to use the code that I have provided to copy A1. The only difference will be in the copy/paste statement, since there will be no transpose.

          .Range("A1).Copy _
            Destination:=wsSummary.Cells(r, "A")

where r is recalculated based on the existing cells in column A.

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[Briscoe]

For my real sheet I am working on I am actually using different cells than A1 and so on, but I was trying to make it easier to understand. Could you please take a look at the following code I have so far and let me know what is wrong. I got an error on the
Range("B5&quot.Copy _
wsSummary.Cells(r, "A&quot.Paste

Here is the code in full:

Set wsSummary = Worksheets("Summary&quot
For Each sh In Worksheets
With sh
If sh.Name <> wsSummary.Name Then
With wsSummary.Range(&quot;A5&quot
If .Value = &quot;&quot; Then
r = .Row
Else
If .Offset(1, 0).Value = &quot;&quot; Then
r = .Row + 1
Else
r = .End(xlDown).Row + 1
End If
End If
End With
Range(&quot;B5&quot.Copy _
wsSummary.Cells(r, &quot;A&quot.Paste
Range(.Cells(10, &quot;G&quot, .Cells(87, &quot;G&quot).Copy
wsSummary.Cells(r, &quot;B&quot.PasteSpecial _
Paste:=xlAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=True
End If
End With
Next

I really do appreciate your help!! Thanks again!

 

[SkipVought]

sh.Range("B5").Copy _
   destination:=wsSummary.Cells(r, "A")

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[Briscoe]

That worked beautifully!!!!
Thank you so much for all of your help!
I really appreciate it!