CODEWITHSUNDEEP
excelvbacopy
T.Grof
T.Grof

Reputation: 29

Copy multiple files in a folder and lines into one masterfile

I am new at creating macros. Only created 5 of them for specific problems.

Could someone help me amend the below macro? I found it on the internet, I amended it to my preferences. But still there is room from improvement. Anyways it works perfectly except for the below.

There would be a lot of files in folder. Each file contains a tab named "PIVOT", where the format are the same, but the amount of data are different.

The range is in the PIVOT tab are from A to AM columns. They start at row 15. And I would only need those lines where the "closed" indication is not written (Status column is in AJ column). I want all of these rows to be copied into a master file under each other. The amount of rows varies greatly - like 0 to 200 depending on the open items.

Secondly, can someone tell me a book, that could be purchased so that I could evolve my knowledge? Thank For your help!

Tibor

Sub Import_to_Master() Dim sFolder As String Dim sFile As String Dim wbD As Workbook, wbS As Workbook

Application.ScreenUpdating = False
Set wbS = ThisWorkbook
sFolder = wbS.Path & "\"

sFile = Dir(sFolder)
Do While sFile <> ""

    If sFile <> wbS.Name Then
        Set wbD = Workbooks.Open(sFolder & sFile) 'open the file; add condition to

         ' >>>>>> Adapt this part
        wbD.Sheets("PIVOT").Range("A15:AM26").Copy
        wbS.Activate
        Sheets("Template").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
         ' >>>>>>
        wbD.Close savechanges:=True 'close without saving
    End If

    sFile = Dir 'next file
Loop
Application.ScreenUpdating = True

End Sub

Upvotes: 0

Views: 155

Answers (2)

user3598756
user3598756

Reputation: 29421

you may be after this:

        ' >>>>>> Adapted part
        With wbD.Sheets("PIVOT")
            With .Range("AM14", .Cells(.Rows.count, 1).End(xlUp)) '<--| reference its column "A:AM" range from row 14 down to column "A" last not empty row
                .AutoFilter Field:=36, Criteria1:="<>closed" '<--| filter referenced range on its 36th column (i.e. column "AJ") with values different from "closed"
                If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then
                    .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy
                    Sheets("Template").Range("A" & Rows.count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                    Application.CutCopyMode = False
                End If
            End With
            .AutoFilterMode = False
        End With
        ' >>>>>>

Upvotes: 1

Tim Wilkinson
Tim Wilkinson

Reputation: 3801

If you need to check each row for a certain cell value use something like the following. This will loop through line by line checking for lines that don't say "Closed".

Dim sFolder As String, sFile As String, wbD As Workbook, wbS As Workbook
Dim lastRowS As Integer, lastRowD As Integer
Application.ScreenUpdating = False
Set wbS = ThisWorkbook
sFolder = wbS.Path & "\"
sFile = Dir(sFolder

lastRowS = Sheets("Template").Range("A" & Rows.Count).End(xlUp).Row + 1

Do While sFile <> ""

If sFile <> wbS.Name Then
    Set wbD = Workbooks.Open(sFolder & sFile) 'open the file; add condition to

    lastRowD = wbD.Sheets("PIVOT").Range("A" & Rows.Count).End(xlUp).Row

    For i = 15 To lastRowD
        If Cells(i, 3) <> "Closed" Then 'change 3 to whatever column number has Closed in
            wbD.Sheets("PIVOT").Rows(i).EntireRow.Copy
            wbS.Sheets("Template").Cells(lastRowS, 1).PasteSpecial xlPasteValues
            lastRowS = lastRowS + 1
        End If
    Next i
    Application.CutCopyMode = False
     ' >>>>>>
    wbD.Close savechanges:=False 'close without saving
End If

sFile = Dir 'next file
Loop
Application.ScreenUpdating = True
End Sub

Upvotes: 0

Related Questions