多工作簿数据复制整理VBA问题求助：后续数据无法写入目标簿

Let’s break down what’s going wrong with your workflow and fix it step by step:

Key Issues in Your Current Code #

• Variable Scope Problems: The TA and wb variables are declared locally inside Macro2, so macro3 can’t access them properly — this causes runtime errors when trying to reference TA in the second subroutine.
• Lost Target Workbook Reference: Each time you run Macro2, the wb variable is re-declared as a fresh local variable. After the first run, your reference to the target workbook (NEWwb) is lost, so the second run creates an entirely new workbook instead of using the existing one.
• Broken Logic Check: The If wb Is Nothing Then check will always be True on the second run because wb is a new local variable, not the one from the first execution.
• Syntax Error: TA.Range("A1:A2").Selection.Font.Bold = True is invalid — you don’t need Selection here; just target the range directly.
• Unnecessary Select/Activate: Using Select and Activate makes your code slow and prone to errors if the active sheet/workbook changes unexpectedly.

Fixed Code #

Here’s the revised code that maintains the target workbook reference across runs, fixes scope issues, and cleans up redundant operations:

' Declare these at the MODULE level to persist across macro runs
Dim wbTarget As Workbook
Dim wsTarget As Worksheet

Sub ProcessCurrentWorkbook()
    Dim wsSource As Worksheet
    Dim wbSource As Workbook
    
    Set wbSource = ActiveWorkbook
    Set wsSource = wbSource.Sheets("Dnevni posli")
    
    ' Check if target workbook exists already
    If wbTarget Is Nothing Then
        ' Create new target workbook and set up headers
        Set wbTarget = Workbooks.Add
        wbTarget.Sheets(1).Name = "Tabela"
        Set wsTarget = wbTarget.Sheets("Tabela")
        SetupTargetSheetHeaders wsTarget
    End If
    
    ' Copy data from current source workbook to target
    CopyDataToTarget wsSource, wsTarget
End Sub

Sub SetupTargetSheetHeaders(ws As Worksheet)
    With ws
        ' Set header text
        .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"
        
        ' Format headers
        With .Range("A3:M3")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Font.Bold = True
            .RowHeight = 25.5
        End With
        
        ' Set column widths
        .Columns("A:A").ColumnWidth = 12
        .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
        
        ' Add borders
        With .Range("A3:M5").Borders
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        ' Remove diagonal borders
        .Range("A3:M5").Borders(xlDiagonalDown).LineStyle = xlNone
        .Range("A3:M5").Borders(xlDiagonalUp).LineStyle = xlNone
    End With
End Sub

Sub CopyDataToTarget(wsSource As Worksheet, wsTarget As Worksheet)
    Dim nextEmptyRow As Long
    
    ' Find the next empty row in column A (after headers)
    nextEmptyRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1
    
    ' Copy static title values
    wsTarget.Range("A1").Value = wsSource.Range("G2").Value
    wsTarget.Range("C2").Value = wsSource.Range("U11").Value
    
    ' Copy data to the next empty row
    wsTarget.Cells(nextEmptyRow, "A").Value = wsSource.Range("AA19").Value
    wsTarget.Cells(nextEmptyRow, "B").Value = wsSource.Range("AB19").Value
    wsTarget.Cells(nextEmptyRow + 1, "B").Value = wsSource.Range("AB19").Value
    wsTarget.Cells(nextEmptyRow, "C").Value = wsSource.Range("AD19").Value
    wsTarget.Cells(nextEmptyRow + 1, "C").Value = wsSource.Range("AD19").Value
    wsTarget.Cells(nextEmptyRow, "D").Value = wsSource.Range("AF19").Value
    wsTarget.Cells(nextEmptyRow + 1, "D").Value = wsSource.Range("AF19").Value
    wsTarget.Cells(nextEmptyRow, "E").Value = wsSource.Range("AG19").Value
    wsTarget.Cells(nextEmptyRow + 1, "E").Value = wsSource.Range("AG19").Value
    wsTarget.Cells(nextEmptyRow, "F").Value = wsSource.Range("AO19").Value
    wsTarget.Cells(nextEmptyRow, "G").Value = wsSource.Range("AP19").Value
    
    ' Copy formulas instead of values
    wsSource.Range("AR20").Copy
    wsTarget.Cells(nextEmptyRow, "H").PasteSpecial Paste:=xlPasteFormulas
    
    ' Copy remaining values
    wsTarget.Cells(nextEmptyRow, "I").Value = wsSource.Range("AU20").Value
    wsTarget.Cells(nextEmptyRow, "M").Value = wsSource.Range("AY20").Value
    
    ' Format top title
    wsTarget.Range("A1:A2").Font.Bold = True
End Sub

What Changed & Why #

1. Module-Level Variables: wbTarget and wsTarget are declared at the top of the module, so they keep their values across macro runs — ensuring we always use the same target workbook for all source files.
2. Split into Focused Subroutines: Broke the code into smaller, easier-to-maintain parts (SetupTargetSheetHeaders and CopyDataToTarget) to simplify debugging and updates.
3. Dynamic Row Detection: Uses nextEmptyRow to find the first empty row in the target sheet, so data from each source workbook is appended below the previous data instead of overwriting it.
4. Removed Select/Activate: All operations target ranges directly, eliminating errors caused by unexpected active sheets.
5. Fixed Syntax Errors: Corrected the bold formatting line and removed invalid Selection references.

How to Use #

1. Open wb1, run ProcessCurrentWorkbook
2. Close wb1, open wb2, run ProcessCurrentWorkbook again — this will append wb2's data to the same target workbook
3. Repeat for any additional workbooks

内容的提问来源于stack exchange，提问作者Blazzz