Copy data on specific sheets if row contains a value

pook_666

Board Regular
Joined
Aug 16, 2018
Messages
94
Hi magicians!

I have a two part query I need help with please...

1 - I want to copy data from sheets with ranges A7:A, B7:B & M7:M (always will start from row 7 in these columns downwards) that aren't sheet names included in the array below (have put Sheet1, Sheet2 & Sheet3 for simplicity & privacy issues)....the issue that I'm facing with the below code is that it is still copying data from sheets in the array? What have I missed here to prevent this from happening?

VBA Code:
'select specified sheets
    For Each ws In ActiveWorkbook.Worksheets
        If IsError(Application.Match(ws.Name, Array("Sheet1", "Sheet2", "Sheet3"), 0)) Then
      
'copy & paste data
            With ws
                lrow2 = .Range("A" & Rows.Count).End(xlUp).Row
                .Range("A7:A" & lrow2).Copy Destination:=Sheets("Sheet4").Range("B" & Rows.Count).End(xlUp).Offset(1)
                .Range("B7:B" & lrow2).Copy Destination:=Sheets("Sheet4").Range("C" & Rows.Count).End(xlUp).Offset(1)
                .Range("M7:M" & lrow2).Copy Destination:=Sheets("Sheet4").Range("E" & Rows.Count).End(xlUp).Offset(1)
            End With
        End If
    Next

2 - in the sheets that aren't Sheet1, Sheet2 & Sheet3 I only want to copy the data in A7:A, B7:B and M7:M if there is data there (there might not be). I've tried putting the below in just above the "With ws" in the above code, but nothing happens when I run the code - not even the copy & paste issue I have in part 1 above!

VBA Code:
If Not IsEmpty(Range("A7").Value) Then

Probably a really easy fix that I can't see, but any help would be appreciated - thanks!
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Hi
If I understand
Try
VBA Code:
If IsError(Application.Match(ws.Name, Array("Sheet1", "Sheet2", "Sheet3"), 0)) = False Then
 
Upvote 0
@mohadin unfortunately that doesn't work as still copies data from Sheet1 - 3, which I don't want....I want to copy from all sheets if A7 contains a value apart from these sheets 1-3.

The other sheet names can change (part of a bigger macro) so can't simply just select the sheets I want....
 
Upvote 0
VBA Code:
 For Each ws In ActiveWorkbook.Worksheets
        If IsError(Application.Match(ws.Name, Array("Sheet1", "Sheet2", "Sheet3"), 0)) = False Then
            'copy & paste data
            With ws
                If Not IsEmpty(.Range("A7").Value) Then
                    lrow2 = .Range("A" & Rows.Count).End(xlUp).Row
                    .Range("A7:A" & lrow2).Copy Destination:=Sheets("Sheet4").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .Range("B7:B" & lrow2).Copy Destination:=Sheets("Sheet4").Range("C" & Rows.Count).End(xlUp).Offset(1)
                    .Range("M7:M" & lrow2).Copy Destination:=Sheets("Sheet4").Range("E" & Rows.Count).End(xlUp).Offset(1)
                End If
            End With
        End If
    Next
 
Upvote 0
I think you should exclude Sheet4 as well
VBA Code:
'select specified sheets
    For Each ws In ActiveWorkbook.Worksheets
        If IsError(Application.Match(ws.Name, Array("Sheet1", "Sheet2", "Sheet3", "Sheet4"), 0)) = False Then
                'copy & paste data
                With ws
                    If Not IsEmpty(.Range("A7").Value) Then
                        lrow2 = .Range("A" & Rows.Count).End(xlUp).Row
                        .Range("A7:A" & lrow2).Copy Destination:=Sheets("Sheet4").Range("B" & Rows.Count).End(xlUp).Offset(1)
                        .Range("B7:B" & lrow2).Copy Destination:=Sheets("Sheet4").Range("C" & Rows.Count).End(xlUp).Offset(1)
                        .Range("M7:M" & lrow2).Copy Destination:=Sheets("Sheet4").Range("E" & Rows.Count).End(xlUp).Offset(1)
                    End If
                End With
            End If
    Next
End Sub
 
Upvote 0
Sorry, Sheet4 was already included in my Array.

It's really strange because if I put "= false" at the end of the "If IsError" line then only sheets1-4 get picked up....if I change it to "= true" then all sheets in the workbook gets picked up?

do you have any idea why that could be?
 
Upvote 0
Well I'm checking it over an over
When <<True>> it picks sheets( 4,5....)
So the only thing I can guess is declaration If you have any
 
Upvote 0
Hi,
see if this update to your code does what you want

VBA Code:
Sub CopyRange()
    Dim ws          As Worksheet, wsDestination As Worksheet
    Dim lrow2       As Long
   
    Set wsDestination = ThisWorkbook.Worksheets("Sheet4")
   
    'select specified sheets
    For Each ws In ThisWorkbook.Worksheets
        Select Case ws.Name
            Case "Sheet1", "Sheet2", "Sheet3", "Sheet4"
                'do nothing
            Case Else
                If Len(ws.Range("A7").Value) > 0 Then
                    lrow2 = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
                    'copy & paste data
                    With wsDestination
                        ws.Range("A7:A" & lrow2).Copy Destination:=.Range("B" & .Rows.Count).End(xlUp).Offset(1)
                        ws.Range("B7:B" & lrow2).Copy Destination:=.Range("C" & .Rows.Count).End(xlUp).Offset(1)
                        ws.Range("M7:M" & lrow2).Copy Destination:=.Range("E" & .Rows.Count).End(xlUp).Offset(1)
                    End With
                End If
        End Select
    Next
End Sub

Dave
 
Upvote 0
Solution
@mohadin & @dmt32 - what I've found is that both of your codes copies the Sheet4 information as well as all other sheets that aren't Sheet1-3.

So A7:A, B7:B & M7:M from Sheet4 are being copied and pasted...is it because that Sheet4 is the destination?

Any ideas how to not include Sheet4 copying?
 
Upvote 0
In your code if you are using this statement Sheet4 will not
VBA Code:
Worksheets
        If IsError(Application.Match(ws.Name, Array("Sheet1", "Sheet2", "Sheet3", "Sheet4"), 0)) = False Then
 
Upvote 0

Forum statistics

Threads
1,213,561
Messages
6,114,316
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top