Excel Forum

Code: Select all

Private Sub CommandButton1_Click()
Set cell_to_paste_next_dataset = Cells(1, 1)
 Set active_workbook = ActiveWorkbook
 Set active_sheet = Sheet2
 Application.DisplayAlerts = False

 File_Path = TextBox1.Value
 strName = Dir(File_Path & "\" & "*.xls")

 Do While strName <> vbNullString

 If active_workbook.Name <> strName And strName <> "" Then
 Workbooks.Open Filename:=File_Path & "\" & strName
 Set dataset_workbook = ActiveWorkbook
 Range(ActiveCell.SpecialCells(xlLastCell), Cells(1)).Copy
 active_sheet.Activate
 Cells(ActiveCell.SpecialCells(xlLastCell).Row, 1).Offset(1, 0).Select
 ActiveSheet.Paste
 dataset_workbook.Close
 End If
 strName = Dir
 Loop
 Application.DisplayAlerts = True
End Sub

Code: Select all

'...other code
Do While strName <> vbNullString
    If active_workbook.Name <> strName And strName <> "" Then
    Workbooks.Open Filename:=File_Path & "\" & strName
    Set dataset_workbook = ActiveWorkbook
    Range(ActiveCell.SpecialCells(xlLastCell), Cells(1)).Copy
    active_sheet.Activate
    active_sheet.Range("b" & Rows.Count).End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
    dataset_workbook.Close
    End If
    strName = Dir
Loop
'...other code

Code: Select all

Do While strName <> vbNullString
    If active_workbook.Name <> strName And strName <> "" Then
    Workbooks.Open Filename:=File_Path & "\" & strName
    Set dataset_workbook = ActiveWorkbook
    Range(ActiveCell.SpecialCells(xlLastCell), Cells(1)).Copy
    active_sheet.Activate
    
    
    Dim i As Long
    Dim r As Long
    Dim j As Long
        
    
    i = Sheet3.Cells(2, Sheet3.Columns.Count).End(xlToLeft).Column
    r = i - 2

    MsgBox ("" & i)
    
    For j = 0 To i
    
    active_sheet.Range("b" & Rows.Count).End(xlUp).Offset(1, j).Select
    ActiveSheet.Paste
    j = j + r
    Next j
    dataset_workbook.Close
    End If
    strName = Dir
    Loop