CODEWITHSUNDEEP
excelvba
Andrei K
Andrei K

Reputation: 79

Save worksheet to a new workbook with the same format and name from a specific cell

I would like to save an entire worksheet to a new workbook, to have the same format, the name of the new workbook to be based on specific cell.

I have the following code: 

Sub cautare_copiere()

'1. declar si setez variabilele
'2. sterg rezultatele vechi
'3. cauta si lipeste intr-un nou tab

Dim datasheet As Worksheet 'de unde este informatia copiata
Dim raportsheet As Worksheet 'unde este copiata informatia
Dim salveaza As Worksheet 'unde se copiaza informatia pentru output
Dim familie As String
Dim ultimulrand As Integer
Dim i As Integer 'numaram randurile

'setez variable

Set datasheet = Sheet1
Set raportsheet = Sheet2
Set salveaza = Sheet4
familie = raportsheet.Range("B2").Value
valoare = raportsheet.Range("D2").Value
cantitate = raportsheet.Range("F2").Value


'sterge datele din tab-ul Raport
salveaza.Range("A5:L200").ClearContents 'ajustez range-ul de unde sterg datele - daca am informatie multa, il maresc
salveaza.Range("A5:L200").ClearFormats



'se duce in tab-ul Copy, cauta si copiaza
datasheet.Select
ultimulrand = Cells(Rows.Count, 1).End(xlUp).Row

'cauta printre randuri si selecteaza informatia pe care o cautam

With datasheet
    For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
        If .Cells(i, 5) = familie And .Cells(i, 8) <= valoare And _
                                      .Cells(i, 7) <= cantitate Then
            'Copierea unui range este relativa la rand....
            .Rows(i).Range("A1,C1,E1:H1").Copy _
                    salveaza.Range("A200").End(xlUp).Offset(1, 0)

        End If
    Next i
End With

'aranjeaza in ordine crescatoare, formateaza pagina si adauga anumite valori inainte de salvare
With salveaza
    .Range("A5:L200").Sort Key1:=.Range("F5"), Order1:=xlAscending 'sorteaza in coloana F in ordine crescatoare
    .Range("A2").MergeArea.Value = .Range("C5") 'adauga valoare in casuta

End With

'selecteaza casuta B2 din Raport dupa ce a terminat de copiat informatia
With raportsheet

   .Select
    .Range("B2").Select

End With

End Sub

It copies data from Sheet1 to Output sheet and then return to Raport sheet. I would like to save the Output sheet to a new workbook and save as B2 value from Raport sheet name.

Thank you!

Upvotes: 0

Views: 74

Answers (1)

QuickSilver
QuickSilver

Reputation: 770

I think you are looking for something like this.

Sub cautare_copiere()

'1. declar si setez variabilele
'2. sterg rezultatele vechi
'3. cauta si lipeste intr-un nou tab

Dim datasheet As Worksheet 'de unde este informatia copiata
Dim raportsheet As Worksheet 'unde este copiata informatia
Dim salveaza As Worksheet 'unde se copiaza informatia pentru output
Dim familie As String
Dim ultimulrand As Integer
Dim i As Integer 'numaram randurile

'setez variable

Set datasheet = Sheet1
Set raportsheet = Sheet2
Set salveaza = Sheet4
familie = raportsheet.Range("B2").Value
valoare = raportsheet.Range("D2").Value
cantitate = raportsheet.Range("F2").Value


'sterge datele din tab-ul Raport
salveaza.Range("A5:L200").ClearContents 'ajustez range-ul de unde sterg datele - daca am informatie multa, il maresc
salveaza.Range("A5:L200").ClearFormats



'se duce in tab-ul Copy, cauta si copiaza
datasheet.Select
ultimulrand = Cells(Rows.Count, 1).End(xlUp).Row

'cauta printre randuri si selecteaza informatia pe care o cautam

With datasheet
    For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
        If .Cells(i, 5) = familie And .Cells(i, 8) <= valoare And _
                                      .Cells(i, 7) <= cantitate Then
            'Copierea unui range este relativa la rand....
            .Rows(i).Range("A1,C1,E1:H1").Copy _
                    salveaza.Range("A200").End(xlUp).Offset(1, 0)

        End If
    Next i
End With

'aranjeaza in ordine crescatoare, formateaza pagina si adauga anumite valori inainte de salvare
With salveaza
    .Range("A5:L200").Sort Key1:=.Range("F5"), Order1:=xlAscending 'sorteaza in coloana F in ordine crescatoare
    .Range("A2").MergeArea.Value = .Range("C5") 'adauga valoare in casuta

End With

'selecteaza casuta B2 din Raport dupa ce a terminat de copiat informatia
With raportsheet

Dim xPath As String

xPath = Application.ActiveWorkbook.path
    raportsheet.Copy
    Application.ActiveWorkbook.SaveAs fileName:=xPath & "\" & .Range("B2").Value, FileFormat:=51 'Change file name to suit your needs
    Application.ActiveWorkbook.Close False


End With

End Sub

Upvotes: 1

Related Questions