Copying data from diffrent sheets to a new sheet

[Kaboki]

Hello all,
I use excel version 2007.
I have a excel file consisted of 300 sheets.
How can I write a macro by which rows 1:100 and columns A:K from each sheet to be copied in a new sheet after each other, that means in the new sheet rows 1:100 are copied from rows 1:100 of sheet 1, rows 101:200 are copied from sheet 2, …
What will be the macro of this?
Thanks for you help.
Kaveh

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub Copyrows()
   Dim Nws As Worksheet, Ws As Worksheet
   
   Set Nws = Sheets.Add.name = "Results"
   For Each Ws In Worksheets
      If Not Ws.name = Nws.name Then
         Ws.Range("A1:K100").Copy Nws.Range("A" & Rows.Count).End(xlUp).Offset(1)
      End If
   Next Ws
End Sub

This assumes that col A will always have data

 

[alansidman]

Option Explicit


Sub MrE()
    Dim ws As Worksheet, sh As Worksheet
    'Name the Master Worksheet.  Assumes sheet is named Master
    Set sh = Sheets("Master")
    Application.ScreenUpdating = False
    Dim rng As Range, lr As Long
    Set rng = ws.Range("A1:K100")
    For Each ws In Worksheets
        If ws.Name <> "Master" Then
            lr = sh.Range("A" & Rows.Count).End(xlUp).Row
            ws.Range(rng).Copy sh.Range("A" & lr + 1)
        End If
    Next ws
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Action completed"


End Sub

 

[Kaboki]

Hi & welcome to MrExcel.
How about

Sub Copyrows()
   Dim Nws As Worksheet, Ws As Worksheet
   
   Set Nws = Sheets.Add.name = "Results"
   For Each Ws In Worksheets
      If Not Ws.name = Nws.name Then
         Ws.Range("A1:K100").Copy Nws.Range("A" & Rows.Count).End(xlUp).Offset(1)
      End If
   Next Ws
End Sub

This assumes that col A will always have data

Hi,
Thanks for your message. but it didn't work.
Three issues:
1- first rows and colums of my sheets are empty.
2- sheets name are not excel name default. They are numbers.
3- my sheets are from right to left.

 

[Kaboki]

Option Explicit


Sub MrE()
    Dim ws As Worksheet, sh As Worksheet
    'Name the Master Worksheet.  Assumes sheet is named Master
    Set sh = Sheets("Master")
    Application.ScreenUpdating = False
    Dim rng As Range, lr As Long
    Set rng = ws.Range("A1:K100")
    For Each ws In Worksheets
        If ws.Name <> "Master" Then
            lr = sh.Range("A" & Rows.Count).End(xlUp).Row
            ws.Range(rng).Copy sh.Range("A" & lr + 1)
        End If
    Next ws
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Action completed"


End Sub

Hi,
This macro didn't work too.

 

[Fluff]

In what way didn't it work?

 

[Kaboki]

In what way didn't it work?

I think since my sheets contain figures, names, and empty columns and rows it didn't work.
this is my file:
https://ufile.io/p4oao

See if it works.
Tnx

 

[Fluff]

Try

Sub Copyrows()
   Dim Nws As Worksheet, Ws As Worksheet
   
   Sheets.Add.Name = "Results"
   Set Nws = ActiveSheet
   For Each Ws In Worksheets
      If Not Ws.Name = Nws.Name Then
         Ws.Range("A1:K100").Copy Nws.Range("D" & Rows.Count).End(xlUp).Offset(1, -3)
      End If
   Next Ws
End Sub