Excel VBA Copy from one sheet to other workbook given multiple criteria

0
votes

I know this question is as old as time, but I am trying to copy data thats on an excel file, to another, based on multiple criteria.

The destination is called "Test.xlsm" and the source is called "Data.xlsx" The idea would be for the code to identify the rows that have the text (1,3,D) on the column A, and copy the entire row to the Sheet1 on the destination Test.xlsm

The first row on Test.xlsm has a header so it has to be left alone when copying data to that sheet.

Both files have the destination and source info on sheets called "Sheet1" as default.

I found this code, but i cant adapt it to use a different worksheet for the source, though any code that does the goal is fine.

Sub Copy()
Dim lr As Long, lr2 As Long, r As Long, ws1 As Worksheet, ws2 As Worksheet, n As Long
Application.ScreenUpdating = False
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
n = 1
lr = ws1.Cells(Rows.Count, "A").End(xlUp).Row
lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
    For r = 2 To lr
        If Range("A" & r).Value = "1" Or Range("A" & r).Value = "3" Or Range("A" & r).Value = "D" Then
            Rows(r).Copy Destination:=ws2.Range("A" & n + 1)
            n = ws2.Cells(Rows.Count, "A").End(xlUp).Row
        End If
    Next r
Application.ScreenUpdating = True
End Sub
2
vbaexcel
Do you just need to specify the workbooks that the sheets are in? E.g. Set ws1 = Application.Workbooks("Data").Sheets("Sheet1") - jamheadart
Subscript out of range, tried defining the path for both and then for just the source for the info Set ws1 = Sheets("Sheet1") Set ws2 = Application.Workbooks("Data.xlsx").Sheets("Sheet1") - Azure Aragami
when i have both files open it does copy, but it copies from whichever sheet on whichever workbook i have open while i click to run it, regardless of me having stated which sheet to use - Azure Aragami
Yes you will definitely need both books open to start it, otherwise you'd need a slightly different method. The reason it's copying from whichever sheet you have open is because you need to specify the sheet for ranges also e.g. If Range("A" & r).Value should become If ws1.Range("A" & r).value - jamheadart
I will post a full code edit below based on both above points covered - jamheadart

2 Answers

0
votes

You'll want to use Workbooks as well, since you are using separate ones, and then set the sheets like the example you provided.

For example:

Dim wkbk1 as Workbook, wkbk2 as Workbook, ws1 as WorkSheet, ws2 as Worksheet
Set wkbk1 = Workbooks.open("C:\path\to\Data.xlsx")
Set wkbk2 = Workbooks.open("C:\path\to\Test.xlsm")

Set ws1 = wkbk1.Sheets("Sheet1")
Set ws2 = wkbk2.Sheets("Sheet1")

From there you can use and modify the code you have.

edit: included OP's workbook and sheet names.

0
votes

Try this edit or note where I've made edits based on the points in comments - I think this should do well!

Sub CopyThings()
Dim lr As Long, lr2 As Long, r As Long, ws1 As Worksheet, ws2 As Worksheet, n As Long
Application.ScreenUpdating = False
Set ws1 = Application.Workbooks("Data").Worksheets("Sheet1")
Set ws2 = Application.Workbooks("Test").WorkSheets("Sheet1")
n = 1
lr = ws1.Cells(Rows.Count, "A").End(xlUp).Row
lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
    For r = 2 To lr
        If ws1.Range("A" & r).Value = "1" Or ws1.Range("A" & r).Value = "3" Or ws1.Range("A" & r).Value = "D" Then
            ws1.Rows(r).Copy Destination:=ws2.Range("A" & n + 1)
            n = ws2.Cells(Rows.Count, "A").End(xlUp).Row
        End If
    Next r
Application.ScreenUpdating = True
End Sub