CODEWITHSUNDEEP
vbaexcel
Jonnyboi
Jonnyboi

Reputation: 557

VBA, Looping through multiple files, copy/paste to last row

I have my code which uses a picker and I choose which csv files I want to gather data from and paste to my master workbook. However the data just replaces itself in column B of my master workbook. I know I have to use .End(xlUp) or .End(xlDown), not sure where to put this.

Here is my code:

Option Explicit
Dim wsMaster As Workbook, csvFiles As Workbook
Dim Filename As String
Dim File As Integer
Dim r As Long

Public Sub Consolidate()

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Title = "Select files to process"
        .Show

        If .SelectedItems.Count = 0 Then Exit Sub

        Set wsMaster = ActiveWorkbook

        For File = 1 To .SelectedItems.Count

            Filename = .SelectedItems.Item(File)

           If Right(Filename, 4) = ".csv" Then
    Set csvFiles = Workbooks.Open(Filename, 0, True)
    r = wsMaster.Sheets("Sheet1").UsedRange.Rows.Count
    csvFiles.Sheets(1).Range("AK:AK").EntireColumn.Copy Destination:=wsMaster.Sheets("Sheet1").Range("A:A").EntireColumn.Offset(0, 1)
    csvFiles.Close SaveChanges:=False 'close without saving
            End If


        Next File 'go to the next file and repeat the process

    End With

    Set wsMaster = Nothing
    Set csvFiles = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True

    End With

End Sub

Edited new code from bruce wayne

Option Explicit
Dim wsMaster As Workbook, csvFiles As Workbook
Dim Filename As String
Dim File As Integer
Dim r As Long

Public Sub Consolidate()

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Title = "Select files to process"
        .Show

        If .SelectedItems.Count = 0 Then Exit Sub

        Set wsMaster = ActiveWorkbook

Dim copyRng As Range, destRng As Range
Dim firstRow As Long
For File = 1 To .SelectedItems.Count

    Filename = .SelectedItems.Item(File)

    If Right(Filename, 4) = ".csv" Then
        Set csvFiles = Workbooks.Open(Filename, 0, True)
        r = wsMaster.Sheets("Sheet1").UsedRange.Rows.Count

        '' This is the main new part
        Set copyRng = csvFiles.Sheets(1).Range("AK1:AK" & r)
        With wsMaster.Sheets("Sheet1")
            firstRow = .Cells(.Rows.Count, 2).End(xlUp).Row
            Set destRng = .Range("A" & firstRow + 1).Offset(0, 1)
        End With
        copyRng.Copy destRng
        ''''''''''
        csvFiles.Close SaveChanges:=False    'close without saving
    End If
Next File

    End With

    Set wsMaster = Nothing
    Set csvFiles = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True

    End With

End Sub

Upvotes: 0

Views: 807

Answers (2)

BruceWayne
BruceWayne

Reputation: 23283

Try replacing the code under Set wsMaster = ActiveWorkbook with this:

Dim copyRng As Range, destRng As Range
Dim firstRow As Long
For File = 1 To .SelectedItems.Count

    Filename = .SelectedItems.Item(File)

    If Right(Filename, 4) = ".csv" Then
        Set csvFiles = Workbooks.Open(Filename, 0, True)
        r = wsMaster.Sheets("Sheet1").UsedRange.Rows.Count

        '' This is the main new part
        Set copyRng = csvFiles.Sheets(1).Range("AK1:AK" & r)
        With wsMaster.Sheets("Sheet1")
            firstRow = .Cells(.Rows.Count, 2).End(xlUp).Row
            Set destRng = .Range("A" & firstRow + 1).Offset(0, 1)
        End With
        copyRng.Copy destRng
        ''''''''''
        csvFiles.Close SaveChanges:=False    'close without saving
    End If
Next File
' etc. etc.

This creates two ranges, and will copy/paste accordingly. It should take your AK1:AK# row and add to column B of your wsMaster.Sheets("Sheet1") worksheet.

Upvotes: 1

jcarroll
jcarroll

Reputation: 577

You'll need to find the last row of the source and of the master sheet. To do that you can adapt this:

EndRow = Worksheets("Sheet1").Range("A:A").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

You can then use the EndRow integer like this to paste where you want. With the coordinates row = EndRow, column = 2 or B: 

Worksheets("Sheet1").Cells(EndRow, 2).Paste

or like this to copy what you want. With the copy range of A1 to EndRow A:

Worksheets("Sheet1").Range(Cells(1, 1), Cells(EndRow, 1)).Copy

Upvotes: 1

Related Questions