VBA Copy/Paste Loop or Filter Copy/Paste? Wherever “A:A” value equals Cell “XX” value

Obbsie

New Member
Joined
Nov 20, 2011
Messages
15
I am very new to VBA, been teaching myself and maybe asking something quite basic. I apologise if this is the case, but I haven't come across anything yet that I can tweek to my needs.

Here's what I'm looking to do (I'm using specific cell references):

For every instance where a cell in SourceWorkbook "A10:A40000" is equal to the value of SourceWorkbook "E7", copy cells in that row from column "C:J" and paste into relevant number of rows within DestinationWorkbook range "C18:J37" (there will never be more than 20 results).

From what I can gather there are a couple of paths the code could go down -

1 - After opening source doc, filter column "A" to equal value of "E7" then copy/paste values of required results into destination doc from "C18" onwards, or

2 - Creating a loop that looks for first instance of "E7" value in "A", copy/paste that row from "C:J" into next blank row within destination doc range "C18:J37", repeat for each instance

The "filtering" option would appear the simplest method, but unfortunately I don't know how to write either. Any help would be greatly appreciated. Thank you.
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Hi have a play with this & see if goes in direction you want.
I went for loop option as said only copying max 20 rows.

I have included some error checking but you will need to change values shown in red & make other changes as required.
Place code in standard module.

Rich (BB code):
Sub CopySourceData()
    Dim LastRow As Long, r As Long
    Dim c As Range
    Dim wbSource As Workbook
    Dim wsDestination As Worksheet
    Dim sPath As String, sFileName As String
    Dim wsSource As String
    '*********************************************************
    '*************Change Values Below As Required*************
    'Source path
    sPath = "C:\Test\"
    'Source filename
    sFileName = "Test.xls"
    'source worksheet name
    wsSource = "Source"
    'destination worksheet
    Set wsDestination = ThisWorkbook.Worksheets("Destination")
    '**********************************************************
    '**********************************************************
    With wsDestination
        r = .Range("C" & .Rows.Count).End(xlUp).Row + 1
    End With
    If r < 18 Then r = 18
    
    'make sure Path / File exists
    If Not Dir(sPath & sFileName, vbDirectory) = vbNullString Then
        Application.ScreenUpdating = False
        On Error GoTo myerror
        Set wbSource = Workbooks.Open(sPath & sFileName, ReadOnly:=True)
        With wbSource.Worksheets(wsSource)
            LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
            For Each c In .Range("A10:A" & LastRow)
                If c.Value = .Range("E7").Value Then
                    .Range(.Cells(c.Row, 3), .Cells(c.Row, 10)).Copy wsDestination.Cells(r, 3)
                    r = r + 1
                End If
            Next c
        End With
        wbSource.Close False
    Else
        MsgBox "File / Path Not Found", 16, "Error"
    End If
myerror:
    Application.ScreenUpdating = True
    If Err > 0 Then
        MsgBox (Error(Err)), 16, "Error"
        If Not wbSource Is Nothing Then wbSource.Close False
    End If
End Sub

Hope helpful

Dave
 
Upvote 0
Thanks for your suggestion Dave, but I had a fiddle around before seeing your post and managed to write something that seems to work for me. It probably has a few unnessecary lines, but it does the trick.

Code:
Sub SearchForDocs()
Application.ScreenUpdating = False
On Error GoTo ErrMsg
Sheets("RetrievalForm").Select
Range("C18:J20").ClearContents
Range("C7").Copy
Workbooks.Open Filename:= _
        "C:\Documents and Settings\fch31\Desktop\Central Storage\CSDB Macro Setup.xls", ReadOnly:=True
Sheets("Stored").Select
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Selection.AutoFilter Field:=1, Criteria1:=Range("E1"), Operator:=xlAnd
Range("C9").Select
Range(Selection, ActiveCell.Offset(0, 7)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("CSDB Submission Macro Setup.xls").Activate
Sheets("RetrievalForm").Select
Range("C17").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Windows("CSDB Macro Setup.xls").Activate
ActiveWindow.Close savechanges:=False
Windows("CSDB Submission Macro Setup.xls").Activate
Range("C7").Select
Exit Sub
ErrMsg:
MsgBox ("There are no documents in storage for Client ID " & Range("C7") & ". If the Client ID is correct, please contact a Central Storage Officer for confirmation"), vbCritical, "No Documents Found"
Windows("CSDB Macro Setup.xls").Activate
Application.CutCopyMode = False
ActiveWindow.Close savechanges:=False
Windows("CSDB Submission Macro Setup.xls").Activate
Range("C7").Select
End Sub

Thanks again for your response though.
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,172
Members
448,554
Latest member
Gleisner2

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