Copying and pasting a specific range in all worksheets but two.

[dougmarkham]

Hi folks,

Situation: I have a specific range---$F$7:$F$13---that I need to copy from all worksheets except two worksheets: sh.name "MACRO" and sh.name "ExtraData". As I don't know how many worksheets I might have to copy $F$7:$F$13 from, I found this macro to faciliate the copy/paste.

Public Sub m()     Dim lRow As Long
     Dim sh As Worksheet
     Dim shArc As Worksheet
     Set shArc = ThisWorkbook.Worksheets("ExtraData")
     For Each sh In ThisWorkbook.Worksheets
         Select Case sh.Name
         [COLOR=#0000ff][B]    Case Is <> "MACRO"[/B][/COLOR]
                 lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row + 1
                 sh.Range("$F$7:$F$13").Copy
                 shArc.Range("A" & lRow).PasteSpecial
         End Select
     Next
     Application.CutCopyMode = False
     Set shArc = Nothing
     Set sh = Nothing
 End Sub

Would anybody be able to help me modify Case Is <> "MACRO" in the above coding so that it excludes both sh.name "MACRO" and sh.name "ExtraData" from the copy function?

Kind regards,

Doug

 

[Fluff]

How about

Public Sub m()
   Dim lRow As Long
   Dim sh As Worksheet
   Dim shArc As Worksheet
   Set shArc = ThisWorkbook.Worksheets("ExtraData")
   For Each sh In ThisWorkbook.Worksheets
      If sh.Name <> "MACRO" And sh.Name <> "ExtraData" Then
         lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row + 1
         sh.Range("$F$7:$F$13").Copy
         shArc.Range("A" & lRow).PasteSpecial
      End If
   Next
   Application.CutCopyMode = False
   Set shArc = Nothing
   Set sh = Nothing
 End Sub

 

[dougmarkham]

How about

Public Sub m()
   Dim lRow As Long
   Dim sh As Worksheet
   Dim shArc As Worksheet
   Set shArc = ThisWorkbook.Worksheets("ExtraData")
   For Each sh In ThisWorkbook.Worksheets
      If sh.Name <> "MACRO" And sh.Name <> "ExtraData" Then
         lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row + 1
         sh.Range("$F$7:$F$13").Copy
         shArc.Range("A" & lRow).PasteSpecial
      End If
   Next
   Application.CutCopyMode = False
   Set shArc = Nothing
   Set sh = Nothing
 End Sub

Thanks for responding Fluff,
I also thought of this as I have another bit of similar vba. The issue with this work around is that for some reason, it only copies cell F11 and pastes it into A2:A8, A16:A24, and A30:36 of sh.name "ExtraData". I have to admit, when this happened, I knew I was stumped...
Any ideas?

Kind regards,

Doug.

 

[Fluff]

Do you have any merged cells?
If not try

      If sh.Name <> "MACRO" And sh.Name <> "ExtraData" Then
         lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row + 1
         sh.Range("F7:F13").Copy shArc.Range("A" & lRow)
      End If

 

[dougmarkham]

Hi Fluff,

I got rid of merged cells and it works now.

Many thanks,

Doug.

 

[Fluff]

Glad to help & thanks for the feedback