Question

我在某些文件中有数据，我想将新工作簿新工作表中的所有文件标题复制到一列中。所有文件都保存在一个文件夹中。例如我有文件， File1：Column1,2,3,4,5是这样的标题我有多个文件。

Column1：Name Column2：Surname Column3：Email Column4：MobNo Column5：Address

结果

（所有文件头）作为

复制到新工作表中

    Column B
     Name
    Surname
    Email
    MobNo
   Address
   Blank Cell

我想将file2标题复制到同一列B中的下一个balnk单元格（即file2 haders从空白单元格复制，依此类推我没有想到代码

感谢您的回答...... !!!!

Answer 1

您可以使用此代码。我假设您正在Sheet1中搜索空白行，然后将Sheet2中的标题（第一行）复制到Sheet1中的空行：

Sub find_next_blank_row()

    Dim search_result As Range   'range search result
    Dim blank_cell As Long

    Set search_result = Worksheets("Sheet1").Range("A:A").Find("")

    If Not search_result Is Nothing Then
        blank_cell = search_result.Row

        Worksheets("Sheet2").Rows(1).Copy
        Worksheets("Sheet1").Rows(blank_cell).PasteSpecial xlPasteValues

    End If

End Sub

Answer 2

Public Sub test()
'DECLARE AND SET VARIABLES
Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Dim mainwb As Workbook
'Dim wb As Workbook


----------


----------


=======

 Dim search_result As Range   'range search result
    Dim blank_cell As Long


Path = "C:\Test\"
Filename = Dir(Path & "*.xls")
'--------------------------------------------
'OPEN EXCEL FILES
 Do While Len(Filename) > 0  'IF NEXT FILE EXISTS THEN
    Set wbk = Workbooks.Open(Path & Filename)
    'MySheet = Application.Caller.Worksheet.Name
    'Set sh = MySheet()
   'Variable = ActiveSheet.Name
  ' Sheets(Variable).Range("A1:D1").Copy
    'Sheets("Sheet2").Column(B2).Select.Activate.Paste
   ' Sheets("Sheet2").Active
    'Columns("B2").Select

  Set wbk = ActiveWorkbook
  Variable = ActiveSheet.Name
  wbk.Sheets(Variable).Rows(1).EntireRow.Copy

   Workbooks("DFT Tool.xlsm").Activate
'Activate Worksheet
Workbooks("DFT Tool.xlsm").Sheets("Sheet2").Activate

' ActiveWorkbook.ActiveSheet
  Sheets("Sheet2").Activate
    'ActiveSheet.Columns("E").Select
    Range("E1").End(xlDown).Offset(1, 0).Select
    'ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
    wbk.Close True
    Filename = Dir
Loop
End Sub

在列中查找空白单元格并使用vba将数据粘贴到空白单元格中

2 个答案: