Loop cell in range and loop in each worksheet - vba

Question

Why code doesn't pick cell in next worksheet? My copy workbook contain 12 worksheets.
Sheet.Name = ("cat","rabbit","cow","sheep"...+8).
Each sheet have same headers. Col(B1:AK1)= year(1979,1980,...2014).
In another folder that I repeatedly open for pasting; File.Name = (1979.xlsx, 1980.xlsx,..,2014.xlsx).
In each sheet got 12 columns . Col(B1:M1)= ("cat","rabbit","cow","sheep"...+8).
Each cell in range loop nicely but worksheet doesn't seem so. When my code finish run, I check paste workbook having the same data from worksheet("cat"). I'm not competent with coding so please advise whenever my code can be improve.
Sub transferPict()
Dim wsC As Integer
Dim cell As Range
Dim Rng As Range
Dim j, i As Long
Dim x As String
Dim Folderpath
Dim file As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
wsC = ThisWorkbook.Sheets.Count
For j = 1 To wsC
i = j + 1
Set Rng = Range("B1:AK1")
For Each cell In Rng
x = cell.Value
cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Folderpath = "F:\Sony Pendrive\Data Baru\Tahun\PasteTahun\"
file = Folderpath & x & ".xlsx"
Workbooks.Open (file)
ActiveWorkbook.Worksheets("sheet1").Select
ActiveSheet.Cells(2, i).Select
ActiveSheet.Paste
ActiveWorkbook.Close saveChanges:=True
Next cell
Next j
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Answer 1

At no point in your code were you specifying which worksheet you want to copy from, so it will always use the "active" sheet.
Hopefully this code will correct your issue:
Sub transferPict()
Dim wsC As Integer
Dim cell As Range
Dim Rng As Range
'Dim j, i As Long ' <--- This is equivalent to Dim j As Variant, i As Long
Dim j As Long, i As Long
Dim x As String
Dim Folderpath
Dim file As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
wsC = ThisWorkbook.Sheets.Count
For j = 1 To wsC
i = j + 1
Set Rng = ThisWorkbook.Sheets(j).Range("B1:AK1")
For Each cell In Rng
x = cell.Value
ThisWorkbook.Sheets(j).Range(cell.Offset(1, 0), cell.Offset(1, 0).End(xlDown)).CopyPicture Appearance:=xlScreen, Format:=xlPicture
Folderpath = "F:\Sony Pendrive\Data Baru\Tahun\PasteTahun\"
file = Folderpath & x & ".xlsx"
Workbooks.Open file
ActiveWorkbook.Worksheets("sheet1").Cells(2, i).PasteSpecial
ActiveWorkbook.Close saveChanges:=True
Next cell
Next j
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub