Copying and organizing data from multiple workbooks to another

Question

So I'm trying to copy and organize certain data from opened workbook (wb1) to new workbook (NEWwb) and then I would close wb1 and open wb2 and do the same process but now copy it to the previously fresh workbook (NEWwb). So for the first part wb1 to NEWwb is OK but then i have some problems...

here is what I have so far...

Sub Macro2()

    Dim TA As Worksheet
    Dim DP As Worksheet
    Dim wb As Workbook
    Dim wbp As Workbook
    Set wbp = ActiveWorkbook
    Set DP = wbp.Sheets("Dnevni posli")


    If wb Is Nothing Then
    Set wb = Workbooks.Add
    ActiveSheet.Name = "Tabela"
    Set TA = wb.Sheets("Tabela")

    Else
    Call macro3
    End If

End Sub

Sub macro3()

    Dim myCellRange As Range
    Set myCellRange = TA.Range("A1")
    If IsEmpty(myCellRange) Then

    With TA
    .Range("A2").Value = "Dnevni posli na dan"
    .Range("A3").Value = "Produkt - podrobno"
    .Range("B3").Value = "Aktiva"
    .Range("C3").Value = "Pasiva"
    .Range("D3").Value = "Izvenbilanca"
    .Range("E3").Value = "Odpisi"
    .Range("F3").Value = "Str. mesto"
    .Range("G3").Value = "Partija"
    .Range("H3").Value = "Pogodba - številka"
    .Range("I3").Value = "Koncni datum"
    .Range("J3").Value = "Datum postopka"
    .Range("K3").Value = "Prijava do dne"
    .Range("L3").Value = "Prejeti PL"
    .Range("M3").Value = "Naziv aplikacije"

    .Range("A3:M3").Select
    .Range("M3").Activate
        With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        .Columns("A:A").ColumnWidth = 12
        .Rows("3:3").EntireRow.AutoFit
        .Rows("3:3").RowHeight = 25.5
        .Columns("D:D").ColumnWidth = 12
        .Columns("H:H").ColumnWidth = 15.5
        .Columns("I:I").ColumnWidth = 9.6
        .Columns("J:J").ColumnWidth = 8.9
        .Columns("M:M").ColumnWidth = 20
        .Range("A3:M3").Select
        .Range("M3").Activate
         With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Selection.Font.Bold = True
        .Range("A3:M5").Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    End With

     TA.Range("A1").Value = DP.Range("G2").Value
     TA.Range("C2").Value = DP.Range("U11").Value
     TA.Range("A4").Value = DP.Range("AA19").Value
     TA.Range("B4").Value = DP.Range("AB19").Value
     TA.Range("B5").Value = DP.Range("AB19").Value
     TA.Range("C4").Value = DP.Range("AD19").Value
     TA.Range("C5").Value = DP.Range("AD19").Value
     TA.Range("D4").Value = DP.Range("AF19").Value
     TA.Range("D5").Value = DP.Range("AF19").Value
     TA.Range("E4").Value = DP.Range("AG19").Value
     TA.Range("E5").Value = DP.Range("AG19").Value
     TA.Range("F4").Value = DP.Range("AO19").Value
     TA.Range("G4").Value = DP.Range("AP19").Value

     DP.Range("AR20").Copy
     TA.Range("H4").PasteSpecial Paste:=xlPasteFormulas

     TA.Range("I4").Value = DP.Range("AU20").Value
     TA.Range("M4").Value = DP.Range("AY20").Value
     TA.Range("A1:A2").Selection.Font.Bold = True

     End If

End Sub

Hi, welcome to SO. Please read this thread on why you shouldn't be using Select stackoverflow.com/questions/10714251/… — Badja

Badja Badja · Accepted Answer · 2019-03-19T11:32:28

Re my comment, here is a great way to avoid using Selection for borders etc

This is for my own project, but it will be easy enough to rip out for yours

Sub BordersAndFilters()


    ReDim aBorderSettings(1 To 8, 1 To 2)   'An Array of length 8x2 (table)
        aBorderSettings(1, 1) = xlDiagonalDown:     aBorderSettings(1, 2) = xlNone
        aBorderSettings(2, 1) = xlDiagonalUp:       aBorderSettings(2, 2) = xlNone
        aBorderSettings(3, 1) = xlEdgeBottom:       aBorderSettings(3, 2) = xlContinuous
        aBorderSettings(4, 1) = xlEdgeLeft:         aBorderSettings(4, 2) = xlContinuous
        aBorderSettings(5, 1) = xlEdgeRight:        aBorderSettings(5, 2) = xlContinuous
        aBorderSettings(6, 1) = xlEdgeTop:          aBorderSettings(6, 2) = xlContinuous
        aBorderSettings(7, 1) = xlInsideHorizontal: aBorderSettings(7, 2) = xlContinuous
        aBorderSettings(8, 1) = xlInsideVertical:   aBorderSettings(8, 2) = xlContinuous

    With ws.Range("A1:O" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)  'Instead of using LastRow
        'Filter and Fit
        .AutoFilter
        .EntireColumn.AutoFit

        'For every nuber in the array, chang ethe borders based on the values in the array
        For i = LBound(aBorderSettings, 1) To UBound(aBorderSettings, 1)
            .Borders(aBorderSettings(i, 1)).LineStyle = aBorderSettings(i, 2)
            If aBorderSettings(i, 2) <> xlNone Then
                .Borders(aBorderSettings(i, 1)).ColorIndex = 0
                .Borders(aBorderSettings(i, 1)).TintAndShade = 0
                .Borders(aBorderSettings(i, 1)).Weight = xlThin
            End If
        Next i

    End With

 End Sub

So my ws is your TA

With ws.Range("A1:O" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)  'Instead of using LastRow

means that you can pull data until the bottom of the used data

Copying and organizing data from multiple workbooks to another

1 Answers