如何修改VBA代码实现第二份表格数据导入分表指定列

I receive two sets of tabular data from different programs each month. I already have a VBA script that splits the first dataset into separate worksheets, grouped by the single-letter values in Column A. Now I need to modify the existing code (or create a new subroutine) to import the second dataset into Column C of the corresponding worksheets (matching the same single-letter category), with a blank column (Column B) between the original data and the new data.

Sample Data #

Dataset 1:

A 122
S 134
D 122

Dataset 2:

A 134
S 154
D 879

Existing Code: #

Sub Copy_Data()
 Dim r As Range, LastRow As Long, ws As Worksheet
 Dim LastRow1 As Long, MyColumn As String
 Dim LastColumn As Long
 Dim src As Worksheet
 'Change this column Letter to the one with the Co ID in
 MyColumn = "A"
 'Change the worksheet name to the one with the data on
 Set src = Sheets("CalAmp")
 LastRow = src.Cells(Cells.Rows.Count, MyColumn).End(xlUp).Row
 For Each r In src.Range(MyColumn & "2:" & MyColumn & LastRow)
         On Error Resume Next
         Set ws = Sheets(CStr(r.Value))
         On Error GoTo 0
         If ws Is Nothing Then
             Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = CStr(r.Value)
             'This row adds a header from the soyrce sheet
             'remove the ' if you want to do that
             'src.Rows(1).Copy ActiveSheet.Range("A1")
             LastRow1 = Sheets(CStr(r.Value)).Cells(Cells.Rows.Count, MyColumn).End(xlUp).Row
             src.Rows(r.Row).Copy Sheets(CStr(r.Value)).Cells(LastRow1 + 1, 1)
             Set ws = Nothing
         Else
              ' Find the last row in the target sheet for the Co ID sheet
            LastRow1 = Sheets(CStr(r.Value)).Cells(Cells.Rows.Count, MyColumn).End(xlUp).Row
        
            ' Find the next available column in the target sheet
            LastColumn = Sheets(CStr(r.Value)).Cells(1, Sheets(CStr(r.Value)).Columns.Count).End(xlToLeft).Column + 1
        
            ' Reset the worksheet variable for the next iteration
            Set ws = Nothing
         End If
    
 Next r
 End Sub

Modified Solution Code #

Create a dedicated subroutine for importing the second dataset (keeps logic separated and clean):

Sub ImportSecondDataset()
    Dim r As Range, LastRow As Long, ws As Worksheet
    Dim LastRowTarget As Long
    Dim src As Worksheet
    Dim categoryCol As String
    Dim targetCol As Long
    
    ' Configure settings - update these to match your workbook
    categoryCol = "A" ' Column containing the single-letter category in Dataset 2
    Set src = Sheets("Dataset2Sheet") ' Replace with your actual Dataset 2 sheet name
    targetCol = 3 ' Column C, where new data will be pasted
    
    LastRow = src.Cells(src.Rows.Count, categoryCol).End(xlUp).Row
    
    For Each r In src.Range(categoryCol & "2:" & categoryCol & LastRow)
        On Error Resume Next
        Set ws = Sheets(CStr(r.Value))
        On Error GoTo 0
        
        ' Only process if the category sheet exists (created by Dataset 1 split)
        If Not ws Is Nothing Then
            ' Find the next empty row in Column C of the target sheet
            LastRowTarget = ws.Cells(ws.Rows.Count, targetCol).End(xlUp).Row + 1
            
            ' Copy the source row to Column C of the matching category sheet
            src.Rows(r.Row).Copy ws.Cells(LastRowTarget, targetCol)
            
            Set ws = Nothing
        End If
    Next r
End Sub

Key Changes & Explanations #

• Fixed Target Column: Hardcodes targetCol = 3 (Column C) to ensure the new data lands exactly where you want, leaving Column B blank as required.
• Skip Missing Sheets: Ignores categories in Dataset 2 that don't have a corresponding sheet (since Dataset 1 would have created all necessary sheets). If you need to create sheets for new categories, add the sheet-creation logic from your original code here.
• Simplified Logic: Removes unused LastColumn variable and focuses only on finding the next empty row in Column C for pasting.

Usage Steps #

1. Update Set src = Sheets("Dataset2Sheet") to use your actual Dataset 2 sheet name.
2. Run Copy_Data first to split Dataset 1 into category-specific sheets.
3. Run ImportSecondDataset to add Dataset 2 data to Column C of each matching sheet.

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