Question

希望为工作簿中的每个列生成新工作表。（完成，粘贴在下面）。如果值在列＆＃39; X＆＃39;。

中，则下一步是粘贴列A的值。

Sub AddSheets()
Dim cell As Excel.Range
Dim wsWithSheetNames As Excel.Worksheet
Dim wbToAddSheetsTo As Excel.Workbook

    Set wsWithSheetNames = ActiveSheet
Set wbToAddSheetsTo = ActiveWorkbook
For Each cell In wsWithSheetNames.Range("A1:d1")    
    With wbToAddSheetsTo
        .Sheets.Add after:=.Sheets(.Sheets.Count)
        On Error Resume Next
        ActiveSheet.Name = cell.Value
        If Err.Number = 1004 Then
          Debug.Print cell.Value & " already used as a sheet name"
        End If
        On Error GoTo 0
        End With
    Next cell
    End Sub

结果将是两张，（课程101，课程203）由一个＆＃39;范围＆＃39;工作表生成代码期间的功能。

第一部分是如何粘贴，是如何在课程101和课程203表上粘贴John的名字，而仅在课程101表上粘贴Jane。

这里是用于生成工作表的代码（我想在这里找到:) :)

{{1}}

Answer 1

上面的代码将用于插入工作表，但在此之后它不会执行任何操作。基于上面的脚本，我写了类似的东西，做了你想要的东西，但稍微容易理解变量和术语。下面粘贴的代码要求您输入主工作表名称或仅将主工作表的名称设置为＆＃34; Main＆＃34;。

这段代码应该更容易理解，因为它会将过程分解为2个块。

Sub FillCourseWorksheets()
  Dim wb As Workbook, cws As Worksheet, ws As Worksheet, found As Boolean
  Dim crw As Long, rw As Long, col As Integer, wsName As String
  Dim CheckString As String, student As String, lastRow As Long
  Dim lastCol As Integer, courseName As String, resultRow As Long

  'this code depends on the main sheet to have the headers in row 1

  '----------------------------------------------------------
  wsName = "Main" 'set this to the name of your main worksheet
  '----------------------------------------------------------


  'set up
  Set wb = ThisWorkbook
  'if you get an error here set the sheet name to main
  Set cws = wb.Worksheets(wsName)
  'use the .end to find the last column and row similar to CTRL + Right/Down
  lastRow = cws.Range("A1").End(xlDown).Row
  lastCol = cws.Range("A1").End(xlToRight).Column

  'go through each column and add a worksheet if needed

  For col = 3 To lastCol
    CheckString = cws.Cells(1, col).Value
    'check if the worksheet already exists
     found = False
    For Each ws In wb.Worksheets
      If ws.Name = CheckString Then
        found = True
        Exit For
      End If
    Next ws
    If found = False Then 'didnt find the sheet. Add it to the workbook
      Set ws = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count)) 'add the worksheet
      ws.Name = CheckString 'name it
      ws.Range("A1").Value = "Name"
      cws.Activate 'activate the main page after insert
    End If
  Next col

  'all worksheets added go through columns again and add data to each worksheet
  For col = 3 To lastCol
    courseName = cws.Cells(1, col).Value
    Set ws = wb.Worksheets(courseName) 'identify the worksheet to use
    For checkrow = 2 To lastRow
      If cws.Cells(checkrow, col).Value <> "" Then
        student = cws.Range("A" & checkrow).Value
        'set the resultrow and check if there is no data
        If ws.Range("A2").Value = "" Then
          resultRow = 2
        Else
          resultRow = ws.Range("A1").End(xlDown).Row + 1
        End If
        ws.Range("A" & resultRow).Value = student 'print out the student
      End If
    Next checkrow
  Next col


  MsgBox "done"



End Sub

在运行此工作簿之前保存您的工作簿，如果您遇到任何问题，请告诉我。

vba - 来自列的新工作表，将列X中的X粘贴到新工作表中

1 个答案: