Copy data between work books with dynamic cells

Question

Trying to copy data from one Excel spreadsheet to another (from New_data to report).

In the New_data spreadsheet I find the second time System (hence why I start the search below the first one at N21) appears then I need to copy all data below it from columns b - k until I hit blank cells. How do I get the amount of rows to only capture filled cells?

Range("B584:K641") needs to be dynamic.

Sub CopyWorkbook()
 Range("N21").Select
    Cells.Find(What:="system", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Range("B584:K641").Select
    Selection.Copy
    Application.WindowState = xlNormal
    Windows("report.xlsx").Activate
    Range("A2").Select
    ActiveSheet.Paste
    Windows("new_data.csv"). _
    Activate
End Sub

Do you need copying the format, too? Otherwise the code can run faster. No need of any selection, activation which only consume Excel resources... Do all columns involved have the same (last) empty row? Do you want pasting in a specific sheet of Report.xlsx? — FaneDuru, Dec 21 '20 at 14:14
The format will be the same, although the final paste will be done with only pasting values. I'll be copying the data into the current active sheet in report.xlsx. The columns run a - k and the rows all end at the same spot — AffectiveGnome, Dec 21 '20 at 14:32
System is in column B, it shows up twice and i need to copy the data after the second time — AffectiveGnome, Dec 21 '20 at 14:36
its just looking for the next system in the spreadsheet, n21 ensures it doesnt grab the first instance of it — AffectiveGnome, Dec 21 '20 at 14:39
Please, test the code I pasted. It searches in column B:B, starting from B21. If nothing found, it sends a message informing about that and stops at that line. If it finds such a cell, it copies from it (inclusively) to the last empty row in column K:K. It assumes that B:B column and K:K have the same last empty row. — FaneDuru, Dec 21 '20 at 14:45
Let us [continue this discussion in chat](https://chat.stackoverflow.com/rooms/226270/discussion-between-affectivegnome-and-faneduru). — AffectiveGnome, Dec 22 '20 at 07:09

FaneDuru · Accepted Answer · 2020-12-21T14:55:45.943

3

Try the next code please. It should be very fast (if I correctly understood where to be searched for 'system', starting with what...). The code assumes that "new_data.csv" is the csv workbook name. If not, you must use its real name when defining shCSV sheet:

Sub CopyWorkbook()
 Dim shR As Worksheet, shCSV As Worksheet, lastRow As Long, systCell As Range, arr

 Set shR = Workbooks("report.xlsx").ActiveSheet   'use here the sheet you need to paste
                                                  'it should be better to use the sheet name. 
                                                  'No need to have the respective sheet activated at the beginning
 Set shCSV = Workbooks("new_data.csv").Sheets(1)  'csv file has a single sheet, anyhow
 lastRow = shCSV.Range("B" & rows.count).End(xlUp).row

  Set systCell = shCSV.Range("B21:B" & lastRow).Find(What:="system", _
             After:=shCSV.Range("B21"), LookIn:=xlFormulas, LookAt _
             :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                                                        False, SearchFormat:=False)
  If systCell Is Nothing Then MsgBox "No 'sytem' cell has been found...": Exit Sub
  arr = shCSV.Range(systCell, shCSV.Range("K" & lastRow)).Value
  shR.Range("A2").Resize(UBound(arr), UBound(arr, 2)).Value = arr
End Sub

edited Dec 21 '20 at 14:55

answered Dec 21 '20 at 14:42

FaneDuru

38,298
4
19
27

Thanks - worked perfectly, just have to copy data between sheets now but I can work that out i believe! – AffectiveGnome Dec 21 '20 at 17:05
1

@AffectiveGnome: Can you better explain what you need? Now, the above code copies data between the sheets, too. Sheets on different workbooks. Theoretically, it is enough to firstly define the sheets where from to copy and the one for copying to. Please, explain in details what you want accomplishing and I will help you. – FaneDuru Dec 21 '20 at 17:59
In the report I go to the first sheet (named First), clear any filled values from C2 down, select B2 down until values are blank, copy across to c2, then clear B, then move to A2 and do the same copying to B (can’t cut, it must be copied then cleared), Move back to the latest sheet, copy data from A2 column into A2 of the first sheet. Then copy data from D2 down but it has to stop copying once the values in A column become blank e.g. if A30 is blank then I only want to capture data D2:D29, then that’s copied over to the most recent sheet K2 as values only – AffectiveGnome Dec 22 '20 at 07:30
@AffectiveGnome: This does not mean only copying from one sheet to another... It is not too complicated, but it is a different issue. If you place another question and tag me, I will post a piece of code. If not, I would suggest the next logic. Firstly define the first sheet and the last one (`Set shF = Workshets("First")` and do the same for the last), then calculate `lastRow` for column B:B, clear column C:C starting from C2 (`shF.range("C2:C" & shF.rows.count).clear`), put the B:B content in an array (`arr = shF.range("B2" & lastRow).value`) and drop the array value in C:C . – FaneDuru Dec 22 '20 at 07:52
@AffectiveGnome: Copying in C:C using `shF.Range("C2").resize(UBound(arr), 1).value = arr`. And proceed similarly with the other columns cases... Like I told you, if you place a new answer and tag me (@FaneDuru), supposing that I will be available, I will post a piece of code... – FaneDuru Dec 22 '20 at 07:54

Orthogod · Answer 2 · 2020-12-21T14:59:56.673

1

I set a range to equal the filtered range and start a loop to count how many none empty cells occur until the first empty cell in column B.

    Sub CopyWorkbook()
        ThisWorkbook.Sheets("new_data").Activate
        Range("N21").Select
        Dim rng As Range
        Set rng = Cells.Find(What:="system", After:=ActiveCell, _
        LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
        MatchCase:=False, _
        SearchFormat:=False)
        Dim i As Double
        i = rng.Row
        Do Until ThisWorkbook.Sheets("new_data").Range("B" & i) = vbNullString
            i = i + 1
        Loop
        i = i - 1
        Range("B" & rng.Row & ":K" & i).Select
        Selection.Copy
        Application.WindowState = xlNormal
        Windows("report.xlsx").Activate
        Range("A2").Select
        ActiveSheet.Paste
        Windows("new_data.csv").Activate
    End Sub

I found a Stack Overflow question that was helpful in finding an answer. Find cell address

edited Dec 21 '20 at 14:59

answered Dec 21 '20 at 13:28

Orthogod

143
1
2
12

tried this one and I get syntax error for Set rng = Cells.Find(What:="system", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) – AffectiveGnome Dec 21 '20 at 14:35
Updated to activate the "new_data" sheet. Is there any other information in the error? – Orthogod Dec 21 '20 at 14:47
1

@SJR Added line continuations. Thank you for the correction. – Orthogod Dec 21 '20 at 15:00
1

Some useful reading matter too https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba – SJR Dec 21 '20 at 15:06

score 1 · Answer 3 · answered Dec 21 '20 at 13:34

Try:

Sub test()

Dim LR As Long
Dim Ini As Long
LR = Range("B" & Rows.Count).End(xlUp).Row 'last non empty row in column B

Ini = Application.WorksheetFunction.Match("system", Range("N21:N" & LR), 0) + 20 'position of system after n21

Range("B" & Ini & ":K" & LR).Copy

'''rest of your code to paste
End Sub

Note that this code is searching word system only in column N. If it's somewhere else, you'll need to adapt the MATCH function

Copy data between work books with dynamic cells

3 Answers3