Copy some cells from "ALL" sheets to specific sheet !

[bigmak]

hello everybody
i have a workbook and i want copy some cells of ALL sheets to specific sheet
for example copy value of salary and tax cells of all sheets of persons to sheet "names".
i record a macro to ["copy H7 and F9 cells of sheet "john" to B2 and C2 cells of sheet "names" ] and send code below :

Sub Macro1()
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=john!R[5]C[6]"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=john!R[7]C[3]"
End Sub

i send some picture of my workbook

 

[DanteAmor]

Try this:

Sub CopyCells()
  Dim sh As Worksheet
  For Each sh In Sheets
    If LCase(sh.Name) <> LCase("names") Then
      Sheets("names").Range("A" & Rows.Count).End(3)(2).Resize(1, 3).Value = Array(sh.Name, sh.[H7], sh.[F9])
    End If
  Next
End Sub

 

[bigmak]

Try this:

Sub CopyCells()
  Dim sh As Worksheet
  For Each sh In Sheets
    If LCase(sh.Name) <> LCase("names") Then
      Sheets("names").Range("A" & Rows.Count).End(3)(2).Resize(1, 3).Value = Array(sh.Name, sh.[H7], sh.[F9])
    End If
  Next
End Sub

your code work great
but one little problem i dont want copy sheet NAMES just want copy sh.[H7], sh.[F9]

and extra question could you improve this code that work when "names" sheet in another workbook ??

 

[DanteAmor]

I put the names of the sheets to be safe. Otherwise, you have to put several validations, if the name exists as a sheet, if it is well written, etc.

 

[bigmak]

could you improve this code that work when "names" sheet in another workbook ??

 

[DanteAmor]

could you improve this code that work when "names" sheet in another workbook ??

Try this:

Sub CopyCells()
  Dim sh As Worksheet
  For Each sh In Workbooks("another_wokbook_name.xlsx").Sheets
    If LCase(sh.Name) <> LCase("names") Then
      Sheets("names").Range("A" & Rows.Count).End(3)(2).Resize(1, 3).Value = Array(sh.Name, sh.[H7], sh.[F9])
    End If
  Next
End Sub