Vba Code - Copy/Paste rows from one workbook to another

[ksamokovliev]

Dear All,

I'm newmember of your forum , but I use it very often to know more about vba codes.

I have read a lot of posts and comments about following issue , but I did not found solution for mine.

I want to create vba code which copy rows from one workbook to another workbook based on date criteria - one of column ( inputing - starting date /ending date)

If you help me to solve this issue I will safe a lot of time for copy and pasting information



Be healthy!

 

[Joe4]

Welcome to the Board!

In these questions, it is important for us to know the structure of your data, if you want an answer that is tailored to your situation.
Otherwise, any answer we provide will probably require modifications on your part, and unless you are already proficient at VBA, you may not be able to do that.

The best way to do this is to post a small example of your data, so we can see how it is structured, and see what rows/columns everything is in.
And then if you also post an example of your expected output, that is even better.

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

 

[ksamokovliev]

Hello Joe4,
Thank you for your fast reply and help
as an attachment I send an example of the file (screenshot) I want to modify.
This is a diary for performing support actions (mechanical department and energy department), ie. of these two files (there is a separate file for each department) I want to copy the information based on the date (column 2) and add this information to an existing file (merged information from the two files), keeping the order of the columns. ( this file is without vba code, other two has codes , userforms, module ana ie.)
In other words, after opening this file using vba code to specify the start date, end date and copy all the lines covering this criteria and paste them on the first blank line of my file.

I how that you undertand me correct.

Thank you again and Be Healthy!

 

[ksamokovliev]

Hello Joe4,
Thank you for your fast reply and help
as an attachment I send an example of the file (screenshot) I want to modify.
This is a diary for performing support actions (mechanical department and energy department), ie. of these two files (there is a separate file for each department) I want to copy the information based on the date (column 2) and add this information to an existing file (merged information from the two files), keeping the order of the columns. ( this file is without vba code, other two has codes , userforms, module ana ie.)
In other words, after opening this file using vba code to specify the start date, end date and copy all the lines covering this criteria and paste them on the first blank line of my file.

I how that you undertand me correct.

Thank you again and Be Healthy!

Sorry for mistake

* I hope that you understand me correct.

 

[Joe4]

Is this other workbook you want to copy already going to be open?
If not, how should it be identified in the VBA code?

 

[ksamokovliev]

Is this other workbook you want to copy already going to be open?
If not, how should it be identified in the VBA code?

Yes , the other file will be opened . after execution of Macro will be close it.

 

[Joe4]

Try something like this:

Sub MyCopyMacro()

    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lr As Long, r As Long, nr As Long
    Dim stDate As Date, endDate As Date
    
    Application.ScreenUpdating = False

'   Set this original file with data and macro as wb1
    Set wb1 = ThisWorkbook

'   Set the worksheet with the data you are copying from
'***YOU MAY NEED TO EDIT THIS***
    Set ws1 = wb1.Sheets("Sheet3")
    
'   Set the open workbook you are copying to
'***YOU WILL NEED TO EDIT THIS, OR PROMPT THE USER FOR VALUE***
    Set wb2 = Workbooks("Book2.xlsx")
    
'   Set the worksheet where you are copying to
'***YOU MAY NEED TO EDIT THIS***
    Set ws2 = wb2.Sheets("Sheet1")
    
'   Prompt for start date and end date
    stDate = InputBox("Please enter the start date")
    endDate = InputBox("Please enter the end date")
    
'   Check date entry
    If endDate < stDate Then
        MsgBox "Start Date must be prior to End Date", vbOKOnly, "ENTRY ERROR! PLEASE TRY AGAIN!"
        Exit Sub
    End If
    
'   Find first new row on destination sheet
    wb2.Activate
    ws2.Activate
    nr = Cells(Rows.Count, "B").End(xlUp).Row + 1
    
'   Find last row with data in column B on source sheet
    wb1.Activate
    ws1.Activate
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    
'   Loop through all rows of data starting with row 2
    For r = 2 To lr
'       See if date in column B falls in our range
        If (Cells(r, "B") >= stDate) And (Cells(r, "B") <= endDate) Then
'           Copy to destination sheets
            Rows(r).Copy
            wb2.Activate
            Cells(nr, "A").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
'           Increment next row counter
            nr = nr + 1
'           Go back to original workbook
            wb1.Activate
        End If
    Next r

    Application.ScreenUpdating = True

    MsgBox "Macro complete!"
    
End Sub

Note that I indicated parts of the code that will need you to update with your particular details.

 

[ksamokovliev]

Try something like this:

Sub MyCopyMacro()

    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lr As Long, r As Long, nr As Long
    Dim stDate As Date, endDate As Date
   
    Application.ScreenUpdating = False

'   Set this original file with data and macro as wb1
    Set wb1 = ThisWorkbook

'   Set the worksheet with the data you are copying from
'***YOU MAY NEED TO EDIT THIS***
    Set ws1 = wb1.Sheets("Sheet3")
   
'   Set the open workbook you are copying to
'***YOU WILL NEED TO EDIT THIS, OR PROMPT THE USER FOR VALUE***
    Set wb2 = Workbooks("Book2.xlsx")
   
'   Set the worksheet where you are copying to
'***YOU MAY NEED TO EDIT THIS***
    Set ws2 = wb2.Sheets("Sheet1")
   
'   Prompt for start date and end date
    stDate = InputBox("Please enter the start date")
    endDate = InputBox("Please enter the end date")
   
'   Check date entry
    If endDate < stDate Then
        MsgBox "Start Date must be prior to End Date", vbOKOnly, "ENTRY ERROR! PLEASE TRY AGAIN!"
        Exit Sub
    End If
   
'   Find first new row on destination sheet
    wb2.Activate
    ws2.Activate
    nr = Cells(Rows.Count, "B").End(xlUp).Row + 1
   
'   Find last row with data in column B on source sheet
    wb1.Activate
    ws1.Activate
    lr = Cells(Rows.Count, "B").End(xlUp).Row
   
'   Loop through all rows of data starting with row 2
    For r = 2 To lr
'       See if date in column B falls in our range
        If (Cells(r, "B") >= stDate) And (Cells(r, "B") <= endDate) Then
'           Copy to destination sheets
            Rows(r).Copy
            wb2.Activate
            Cells(nr, "A").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
'           Increment next row counter
            nr = nr + 1
'           Go back to original workbook
            wb1.Activate
        End If
    Next r

    Application.ScreenUpdating = True

    MsgBox "Macro complete!"
   
End Sub

Note that I indicated parts of the code that will need you to update with your particular details.

Good evening Joe4,
Thank you for your fast helping.
I try your code to my workbooks, but unfortunately nothing happened.
1st when I select Date range approx 5 day ( than means around 16 or 20 rows) I need to wait during execution of code approx. 3-4min. I don't know why? May b you know better than me.
2nd I created two simply files with same construction like mine ( w/o full data which I have). Unfortunately when I copy your code to my workbooks and execute it I received the MsgBox - Macro Complete , but the data are no copied .
Because I don't know how to use xl2bb add-in I try to explain here.
The file from which I want to copy is " Data from department.xlsx" with Sheet name "Sheet1"
The fiel to which I want to copy is "Whole colleted data.xlsx" with Sheet name "Sheet2"

I paste your code to vba "Whole collected data.xlsx" / Microsoft excel object / sheet2
the fulfilled code is:
Sub MyCopyMacro()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lr As Long, r As Long, nr As Long
Dim stDate As Date, endDate As Date

Application.ScreenUpdating = False

' Set this original file with data and macro as wb1
Set wb1 = Workbooks("Data from department.xlsx")

' Set the worksheet with the data you are copying from
'***YOU MAY NEED TO EDIT THIS***
Set ws1 = wb1.Sheets("Sheet1")

' Set the open workbook you are copying to
'***YOU WILL NEED TO EDIT THIS, OR PROMPT THE USER FOR VALUE***
Set wb2 = Workbooks("Whole collected data.xlsx")

' Set the worksheet where you are copying to
'***YOU MAY NEED TO EDIT THIS***
Set ws2 = wb2.Sheets("Sheet2")

' Prompt for start date and end date
stDate = InputBox("Please enter the start date")
endDate = InputBox("Please enter the end date")

' Check date entry
If endDate < stDate Then
MsgBox "Start Date must be prior to End Date", vbOKOnly, "ENTRY ERROR! PLEASE TRY AGAIN!"
Exit Sub
End If

' Find first new row on destination sheet
wb2.Activate
ws2.Activate
nr = Cells(Rows.Count, "B").End(xlUp).Row + 1

' Find last row with data in column B on source sheet
wb1.Activate
ws1.Activate
lr = Cells(Rows.Count, "B").End(xlUp).Row

' Loop through all rows of data starting with row 2
For r = 2 To lr
' See if date in column B falls in our range
If (Cells(r, "B") >= stDate) And (Cells(r, "B") <= endDate) Then
' Copy to destination sheets
Rows(r).Copy
wb2.Activate
Cells(nr, "A").Select
ActiveSheet.Paste
Application.CutCopyMode = False
' Increment next row counter
nr = nr + 1
' Go back to original workbook
wb1.Activate
End If
Next r

Application.ScreenUpdating = True

MsgBox "Macro complete!"

End Sub




Would you help me.
Thank you again.

 

[Joe4]

Confirm that your dates are being entered/converted properly.

So after this section of code:

' Prompt for start date and end date
stDate = InputBox("Please enter the start date")
endDate = InputBox("Please enter the end date")

add this line:

MsgBox "Date range: " & Format(stDate,"yyyy-mmm-d") & " through " & Format(endDate,"yyyy-mmm-d")

Then run your code, and see if the date range message box that pops up matches what you entered.

Also, confirm that your dates in column B are actually entered as dates, and not text.
Here is one way to check. If your first date is in cell B2, enter this formula in any blank cell and see what it returns:
=TYPE(B2)

 

[ksamokovliev]

Good evening Joe4,
Thank you for your fast helping.
I try your code to my workbooks, but unfortunately nothing happened.
1st when I select Date range approx 5 day ( than means around 16 or 20 rows) I need to wait during execution of code approx. 3-4min. I don't know why? May b you know better than me.
2nd I created two simply files with same construction like mine ( w/o full data which I have). Unfortunately when I copy your code to my workbooks and execute it I received the MsgBox - Macro Complete , but the data are no copied .
Because I don't know how to use xl2bb add-in I try to explain here.
The file from which I want to copy is " Data from department.xlsx" with Sheet name "Sheet1"
The fiel to which I want to copy is "Whole colleted data.xlsx" with Sheet name "Sheet2"

I paste your code to vba "Whole collected data.xlsx" / Microsoft excel object / sheet2
the fulfilled code is:
Sub MyCopyMacro()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lr As Long, r As Long, nr As Long
Dim stDate As Date, endDate As Date

Application.ScreenUpdating = False

' Set this original file with data and macro as wb1
Set wb1 = Workbooks("Data from department.xlsx")

' Set the worksheet with the data you are copying from
'***YOU MAY NEED TO EDIT THIS***
Set ws1 = wb1.Sheets("Sheet1")

' Set the open workbook you are copying to
'***YOU WILL NEED TO EDIT THIS, OR PROMPT THE USER FOR VALUE***
Set wb2 = Workbooks("Whole collected data.xlsx")

' Set the worksheet where you are copying to
'***YOU MAY NEED TO EDIT THIS***
Set ws2 = wb2.Sheets("Sheet2")

' Prompt for start date and end date
stDate = InputBox("Please enter the start date")
endDate = InputBox("Please enter the end date")

' Check date entry
If endDate < stDate Then
MsgBox "Start Date must be prior to End Date", vbOKOnly, "ENTRY ERROR! PLEASE TRY AGAIN!"
Exit Sub
End If

' Find first new row on destination sheet
wb2.Activate
ws2.Activate
nr = Cells(Rows.Count, "B").End(xlUp).Row + 1

' Find last row with data in column B on source sheet
wb1.Activate
ws1.Activate
lr = Cells(Rows.Count, "B").End(xlUp).Row

' Loop through all rows of data starting with row 2
For r = 2 To lr
' See if date in column B falls in our range
If (Cells(r, "B") >= stDate) And (Cells(r, "B") <= endDate) Then
' Copy to destination sheets
Rows(r).Copy
wb2.Activate
Cells(nr, "A").Select
ActiveSheet.Paste
Application.CutCopyMode = False
' Increment next row counter
nr = nr + 1
' Go back to original workbook
wb1.Activate
End If
Next r

Application.ScreenUpdating = True

MsgBox "Macro complete!"

End Sub




Would you help me.
Thank you again.

Confirm that your dates are being entered/converted properly.

So after this section of code:

' Prompt for start date and end date
stDate = InputBox("Please enter the start date")
endDate = InputBox("Please enter the end date")

add this line:

MsgBox "Date range: " & Format(stDate,"yyyy-mmm-d") & " through " & Format(endDate,"yyyy-mmm-d")

Then run your code, and see if the date range message box that pops up matches what you entered.

Also, confirm that your dates in column B are actually entered as dates, and not text.
Here is one way to check. If your first date is in cell B2, enter this formula in any blank cell and see what it returns:
=TYPE(B2)

Great!After your recomendation the code works properly. Everythis is copy/paste correct.

Only one not understanded issue for me.Why execution of this code ( for 10 rows) the duration time is approx 57 sec. ? Do you know why ? Can we reduce this , because when I try it in simplified files ( with total several rows , not approx 4200) execution was immidiatly.

Thank you again for your helping .

Best Excel Forum!