Results 1 to 9 of 9
  1. #1
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts

    Macro to open up files and copy to row after last data

    I have tried to write code to select a csv file/s and to copy data from the source sheet from A1 Col P and to paste this in sheet1 in the destination workbook after the last row containing data


    However, when running the macro, only the first row in pasted in the destination workbook

    It would be appreciated if someone could kindly amend my code so that the data is correctly copied and also to take out any code that is unnecessary


    Code:
     Sub copyDataFromSource()
    ChDir ("C:\extract")
    Dim LR As Long
    
    Sheets(1).Select
    
    Dim sourceBook As Workbook
    Dim destinationBook As Workbook
    Dim sourceSheet As Worksheet
    Dim destinationSheet As Worksheet
    Dim fileSource, sourceRow%, sourceRowCount&, destRow%
    With Application
        .ScreenUpdating = False
    End With
    LR = Cells(Rows.Count, "A").End(xlUp).Row
    
    fileSource = Application.GetOpenFilename
    If fileSource = False Or IsEmpty(fileSource) Then Exit Sub
    Set destinationBook = ThisWorkbook
    Set destinationSheet = destinationBook.Sheets(1)
    Set sourceBook = Workbooks.Open(fileSource)
    Set sourceSheet = sourceBook.Sheets(1)
    
    Sheets(1).Select
    
    With destinationSheet
    .Range("A1:P" & LR).ClearContents
        .Range("a1:P" & LR).Value = sourceSheet.Range("a1:P" & LR).Value
        
    End With
    sourceBook.Close False
    With Application
        .ScreenUpdating = True
    End With
    Set sourceBook = Nothing
    Set destinationBook = Nothing
    Set sourceSheet = Nothing
    Set destinationSheet = Nothing
    ChDir ("C:\My Documents")
    
    End Sub

  2. #2
    2 Star Lounger
    Join Date
    Dec 2009
    Location
    Surrey, UK
    Posts
    161
    Thanks
    7
    Thanked 39 Times in 35 Posts
    I ran the code in Excel 2000, and it mostly worked. I had to remove the second 'sheets(1).select, this produced an obscure error. I think your problem is the setting of LR: initially, unless you have contents in the destination sheet (the one with the code), LR returns one (it did for me). Try populating sufficient rows with dummy data and try again. If you want to copy to a blank sheet, you will have to set LR from the source after loading it.

    I could not see any significant code that could or needs to be removed - but you can control updating in one line with 'Application.ScreenUpdating = False'.

    Update: Have now read you question more carefully: Currently you are clearing the destn from A1:P<LR>, but that doesn't match your declared intent: to copy from the last used row (LR) in destn. So first, stop that clearing, then we need to know how many rows you want to copy: A1 to P-what?

    If you can answer this, it ought to be easy...
    HTH, Martin (pleased to be the first to get here, I'm usually following up others)
    Last edited by mngerhold; 2015-10-30 at 10:53.

  3. #3
    2 Star Lounger
    Join Date
    Dec 2009
    Location
    Surrey, UK
    Posts
    161
    Thanks
    7
    Thanked 39 Times in 35 Posts
    OK, having read the qn properly (?), this is my offering:
    Code:
    Sub copyDataFromSource()
    ChDir ("D:\")
    Dim sourceBook As Workbook, destinationSheet As Worksheet, source_sheet As Worksheet
    Dim fileSource, LR As Long, source_rows As Long
    
    Application.ScreenUpdating = False
    Sheets(1).Activate
    'get last used row (in any column)
    LR = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    fileSource = Application.GetOpenFilename
    If fileSource = False Or IsEmpty(fileSource) Then Exit Sub
    Set destinationSheet = ActiveSheet          'remember where we were
    
    Set sourceBook = Workbooks.Open(fileSource) 'open file
    Set source_sheet = sourceBook.Sheets(1)
    source_rows = source_sheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    source_sheet.Range("a1:p" & source_rows).Copy  'copy what we want
    destinationSheet.Activate                   'back to destination
    With destinationSheet
        .Range("a" & LR + 1).Select             'select last row + 1
        .Paste                                  'paste copied range
    End With
    sourceBook.Close False
    Application.ScreenUpdating = True
    Set sourceBook = Nothing
    Set source_sheet = Nothing
    Set destinationSheet = Nothing
    
    End Sub
    It is better (?) to set the last row LR using the function that looks across all columns (unless you don't want to). Then, since I don't know how many rows you want to copy, I do the same after opening the source book, and then copy the range (columns A:P only) to the buffer. It is then easy to select the next row down in the destination and simply paste the lot. I'm sure you can work from that. good luck, Martin

  4. #4
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Thanks for the help Martin, much appreciated

    The macro runs without any errors, but no data is copied. Kindly check & amend the code

  5. #5
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Martin

    I have amended the code as follows and it now copies the data

    Code:
     Sub copyDataFromSource()
    
    
    
    ChDir ("C:\extract")
    
    A:
    Dim A     As Variant
        
        
        A = Application.GetOpenFilename
        If A = False Or IsEmpty(A) Then Exit Sub
        
        Application.ScreenUpdating = False
        
        With Workbooks.Open(A)
            With .Sheets(1)
                .Range("a1", .Range("n" & Rows.Count).End(xlUp)).Copy _
                    Destination:=ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1)
            End With
            .Close SaveChanges:=False
        End With
       answer = MsgBox("Does another file needs to be selected?", vbYesNo + vbQuestion, "Hello")
    If answer = vbYes Then
    GoTo A:
    End If
     Application.ScreenUpdating = True
        
    End Sub
    Instead of opening each csv file , I would like the macro amended to import all the latest csv files in the directory C:\extract containing starting with HO.run number .........


    It would be appreciated if you could amend my code accordingly

  6. #6
    2 Star Lounger
    Join Date
    Feb 2015
    Posts
    128
    Thanks
    19
    Thanked 1 Time in 1 Post
    Hi Howard,

    I created a excel macro last year which converts each CSV file saved in a particular location into Excel and rename it with the name of CSV file. Please let me know if it will be useful to you or not?

    Regards,
    Jaggi

  7. #7
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Jaggi

    Thanks for the reply

    I would like to obtain a copy of your workbook as this will be helpful

  8. #8
    2 Star Lounger
    Join Date
    Feb 2015
    Posts
    128
    Thanks
    19
    Thanked 1 Time in 1 Post

    Post

    Hi Howard,

    Really sorry for the late reply on this thread, was bit busy throughout the month. Enclosed is the macro I was talking about. Hope this help us.

    Regards,
    JD
    Attached Files Attached Files

  9. #9
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Thanks very much for your code

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •