excel - 将数据从多个工作簿复制和组织到另一个工作簿

Question

因此，我尝试将某些数据从打开的工作簿 (wb1) 复制和组织到新工作簿 (NEWwb)，然后我将关闭 wb1 并打开 wb2 并执行相同的过程，但现在将其复制到以前的新工作簿 (NEWwb)。所以对于第一部分 wb1 到 NEWwb 是可以的，但后来我遇到了一些问题......

这是我到目前为止...

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

标签： excelvba

Answer 1

回复我的评论，这是避免使用Selection边框等的好方法

这是我自己的项目，但很容易为你的项目撕掉

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

所以我ws是你的TA

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

表示可以拉取数据直到使用数据的底部