copy a cell from multiple workbooks into specific cells in the another sheet using VBA

Question

i have around 200 workbooks each one contains 5 sheets i want to extract data from specific cells in sheet 1 and 2 and 3 (lest say sheet 1 needs cells B2,B6,B8..... and sheet 2 cells B2,C2,D2... and sheet 3 B6,D6...) then past them into one sheet in specific order (lest say from sheet one goes to A,B,C.... columns respectively and from sheet 2 follows in columns D,E,F,.... then from sheet 3 also follows columns G,H,I..... In short i want to make a table from the extracted cells

the bellow is mix between a recorded macro of all the operations of copy past and another code i found it in the forum about fetching folders but it seems it is not working help plz

    enterPrivate Sub Test15()

Dim iRow&
Dim FileName$, sPath$
Dim wb As Workbook, wbSurvey As Workbook
Dim wsSurvey As Worksheet, WS As Worksheet

sPath = "C:\Users\Okinawa Office\Downloads\TSSR REPORTS BATCH 07.08.2022"

Set wbSurvey = ThisWorkbook
Set wsSurvey = wbSurvey.Sheets("Survey")

'FileName = Dir(strFolder & "\*123.xls")
 FileName = Dir(sPath)
 iRow = 2
Do While Len(FileName) > 0
Set wb = Workbooks.Open(FileName)

'change the phrase FIRST TAB here to the name of the first sheet, which is used in your process.
Set WS = wb.Sheets("Basic Information")

'this is how the edited code below needs to look. cutcopymode and scroll down lines of code can be deleted
WS.Range("B2").Copy
wsSurvey.Range("B" & iRow).PasteSpecial (xlPasteValues)

'this is an example of which lines of code need to be edited to look like the above two lines of code.
WS. _
    Activate
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
Range("C" & iRow).PasteSpecial (xlPasteValues)

WS. _
    Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
Range("D" & iRow).PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D6").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
Range("E" & iRow).PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("F5").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
Range("F" & iRow).PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
Range("G" & iRow).PasteSpecial (xlPasteValues)

Set WS = wb.Sheets("RF")

WS. _
    Activate
Range("B4").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
Range("H" & iRow).PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
Range("I" & iRow).PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B7").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("I2").Select
.PasteSpecial (xlPasteValues)
Range("J" & iRow).PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B8").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
Range("K" & iRow).PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B9").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B10").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("L" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B11").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("M" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B12").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("N" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B13").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("O" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("P" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B21").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("Q" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B22").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("R" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B23").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("S" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B24").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("T" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B25").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("U" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B26").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("V" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C4").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("W" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Range("C6").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("X" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("Y" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C8").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("Z" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C9").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AA" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C10").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AB" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C11").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AC" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C12").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AD" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C13").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AE" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C14").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AF" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C21").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AG" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C22").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AH" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C23").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AI" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C24").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AJ" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _


enter code      Activate
Range("C25").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AK" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C26").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AL" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D4").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AM" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D6").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AN" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D7").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AO" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D8").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AP" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D9").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AQ" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D10").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AR" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D11").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AS" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D12").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AT" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D13").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AU" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
ActiveWindow.SmallScroll Down:=9
Range("D14").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AV" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D15").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AW" & iRow).PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D21").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D22").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AX" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
ActiveWindow.SmallScroll Down:=6
Range("D23").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AY" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D24").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("AZ" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D25").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BA" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("D26").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BB" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)

Set WS = wb.Sheets("TI&PW")

WS. _
    Activate
ActiveWindow.SmallScroll Down:=-27
Range("D2").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
Range("BD" & iRow).PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("B3").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BE" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
Range("BF" & iRow).PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C11").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("F11").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BG" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C12").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BH" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("F12").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C18").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BJ" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("F18").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BK" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C19").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BL" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("F19").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BM" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C20").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BN" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("F20").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
Range("BP" & iRow).PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C21").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("F21").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BQ" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
ActiveWindow.SmallScroll Down:=6
Range("C27").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BR" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("F27").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BS" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C28").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BT" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("F28").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BU" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C29").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BV" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("F29").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BW" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C30").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BX" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("F30").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BY" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C31").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("BZ" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("F31").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("CA" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("C32").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("CB" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)
WS. _
    Activate
Range("F32").Select
Application.CutCopyMode = False
Selection.Copy
wsSurvey
Range("CC" & iRow).PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteValues)

wb.Close (False)
FileName = Dir
iRow = iRow + 1

Loop

End Subde here code here

here

copy a cell from multiple workbooks into specific cells in the another sheet using VBA

0 Answers