Transfer Data Across the sheet

[HKB]

I have attached my sample sheet with code, it's perfect for me it's create new sheet and transfer data form "Master Sheet" "A:D" to new sheet "A:D".

Hovever I want transfer data from "Master Sheet", "B:E" in to new sheet "A:C".(Skip Date Row "A").

Help please

 

[Monty]

Hello HKB

Sorry i haven't seen your code...Based on the request written code in short.

Let me know any challenges...Happy to help you.

 

[HKB]

Option Explicit


Sub CreateSheetsTransferData()
        Dim ar As Variant
        Dim i As Integer
        Dim lr As Long
        Dim ws As Worksheet
        Dim sh As Worksheet

Application.ScreenUpdating = False

lr = Range("A" & Rows.Count).End(xlUp).Row

Set sh = Sheet1
ar = sh.Range("A2", sh.Range("A" & sh.Rows.Count).End(xlUp))

For i = LBound(ar) To UBound(ar)
        If Not Evaluate("ISREF('" & ar(i, 1) & "'!A1)") Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = ar(i, 1)
        End If
        Set ws = Worksheets(CStr(ar(i, 1)))
        Worksheets.FillAcrossSheets sh.[A1:F1]
        sh.Range("A1", sh.Range("A" & sh.Rows.Count).End(xlUp)).AutoFilter 1, ar(i, 1)
        sh.Range("A2", sh.Range("E" & sh.Rows.Count).End(xlUp)(2)).Copy ws.Range("A" & Rows.Count).End(3)(2)
        sh.Range("A2", sh.Range("E" & sh.Rows.Count).End(xlUp)(2)).ClearContents
        ws.Columns.AutoFit
        sh.[A1].AutoFilter
  Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
sh.Select
Range("A2").Select
MsgBox "Sheets created/data transfer completed!", vbExclamation, "STATUS"

End Sub

 

[Monty]

Excellent