excel vba - VBA to import and transpose multiple sheets data -

i have been working on below code, looking edit further:

1) instead of setting 'set range1' via input box, should cell range of 'b2:p65' when looping through sheets in folder.

2) when pasting data want fill starting @ column b of 'database' tab in workbook , subsequently c, d, e etc.. rest of workbooks in folder loop.

sub loopfileupload_base() dim wb workbook dim mypath string dim myfile string dim myextension string dim fldrpicker filedialog dim range1 range, range2 range, rng range dim rowindex integer    application.screenupdating = false   application.enableevents = false   application.calculation = xlcalculationmanual    set fldrpicker = application.filedialog(msofiledialogfolderpicker)      fldrpicker       .title = "select target folder"       .allowmultiselect = false         if .show <> -1 goto nextcode         mypath = .selecteditems(1) & "\"     end nextcode:   mypath = mypath   if mypath = "" goto resetsettings    myextension = "*.xlsx"    myfile = dir(mypath & myextension)    while myfile <> ""       set wb = workbooks.open(filename:=mypath & myfile)  'change code below here  xtitleid = "range" set range1 = application.selection set range1 = application.inputbox("source ranges:", xtitleid, range1.address, type:=8) set range2 = application.inputbox("convert (single cell):", xtitleid, type:=8) rowindex = 0  each rng in range1.rows     rng.copy     range2.offset(rowindex, 0).pastespecial paste:=xlpastevalues, transpose:=true     rowindex = rowindex + rng.columns.count next  'change code above here        wb.close savechanges:=true       myfile = dir   loop    msgbox "task complete!"  resetsettings:     application.enableevents = true     application.calculation = xlcalculationautomatic     application.screenupdating = true  end sub 

consider following macro loop through .xlsx workbooks in folder , iteratively copy cells in specified range current sheet row row. then, after each workbook move next column:

sub transposeworkbooks()     dim strfile string     dim sourcewb workbook     dim integer, j integer     dim cell range      strfile = dir("c:\path\to\workbooks\*.xlsx")      thisworkbook.sheets("database").activate     thisworkbook.sheets("database").range("a2").activate      while len(strfile) > 0          ' open source workbook         set sourcewb = workbooks.open("c:\path\to\workbooks\" & strfile)          thisworkbook.activate         activecell.offset(0, 1).activate                    ' move next column         activecell = strfile          ' iterate through each cell across range         j = 1         each cell in sourcewb.sheets(1).range("b2:p65")             activecell.offset(j, 0).value = cell.value      ' move next row             j = j + 1         next cell          ' close workbook         sourcewb.close false         strfile = dir     loop  end sub