[Rozwiązano] VBA Excel: Jak scalić skoroszyty xls zaczynając od wiersza 3 bez pomijania danych?

Witam,
Znalazłam w Internecie kod makra, które jest podstawą do pomocy przy tworzeniu mojego. Jednak jest to moje pierwsze makro, które tworzę dla kolegów i koleżanek. W swoim makro chciała bym aby rozpoczęcie łączenia plików excela rozpoczynało się zawsze w wierszu 3 (nagłówek w pierwotnym skoroszycie jest zawsze w 3 wierszu, pierwsze dwa wiersze są puste) oraz aby makro łączyło wszystkie dane ze skoroszytów nie zależnie czy napotka pusty wiersz ponieważ w pierwotnych plikach excel, znajdują się nieraz puste wiersze pomiędzy danymi. Przedstawione makro łączy tylko do pustego wiersza, pomijając dane które są za pustymi wierszami. Zależy mi tylko aby poprawnie scalić pliki excel, które załączam do tematu. Baaaaaardzo proszę Państwa o pomoc!

Założenia do mojego makro jakie podałam
1. Wszystkie skoroszyty do scalenia znajdują się w jednym folderze
' 2. Nie ma tam żadnych skoroszytów przypadkowych (w tym docelowego)
' 3. Dane do scalenia są zawsze w pierwszym arkuszu i mają jednakowe kolumny
' 4. Dane do scalenia mają nagłówki
‘ 5. Brak pustych wierszy pomiędzy danymi
‘ 6. Tylko format xlsx we folderze
'7. W pierwszym wierszu musi być nagłówek

Założenia jakie chciałabym żeby było makro
1. Wszystkie skoroszyty do scalenia znajdują się w jednym folderze
' 2. Nie ma tam żadnych skoroszytów przypadkowych (w tym docelowego)
' 3. Dane do scalenia są zawsze w pierwszym arkuszu i mają jednakowe kolumny
' 4. Dane do scalenia mają nagłówki
‘ 5. Możliwość pustych wierszy
‘ 6. Tylko format xlsx we folderze
' 7. Łączenie od 3 wiersza w którym znajduje się nagłówek w plikach do scalenia

Powinnaś znaleźć gotowca na forum. Poszukaj.

Problem rozwiązany

dodałam do kodu 3

Application.ScreenUpdating = True
Set Skonsolidowany = Worksheets.Add()
Plik = Dir(Folder & "*.xls")
Do Until Len(Plik) = 0
Licznik = Licznik + 1
Application.StatusBar = "Konsolidacja pliku nr " & Licznik
Set Skor = Workbooks.Open(Folder & Plik)
Set Ark = Skor.Sheets(1)

iRows = Sheets(1).UsedRange.Rows.Count + 1

For i = iRows To 1 Step -1

If Cells(i, 1) = "" Then Rows(i).EntireRow.Delete

Next
If Licznik = 1 Then
Set Naglowki = Ark.Range("A1").CurrentRegion.Rows(1)
Naglowki.Copy Skonsolidowany.Range("A1")
Set KomDocel = Skonsolidowany.Range("A2")
Else
Set ZakresDocel = Skonsolidowany.Range("A1").CurrentRegion
LW_Docel = ZakresDocel.Rows.Count
Set KomDocel = Skonsolidowany.Cells(LW_Docel + 1, 1)
End If

Problem rozwiązany

dodałam do kodu 3

Application.ScreenUpdating = True
Set Skonsolidowany = Worksheets.Add()
Plik = Dir(Folder & "*.xls")
Do Until Len(Plik) = 0
Licznik = Licznik + 1
Application.StatusBar = "Konsolidacja pliku nr " & Licznik
Set Skor = Workbooks.Open(Folder & Plik)
Set Ark = Skor.Sheets(1)

iRows = Sheets(1).UsedRange.Rows.Count + 1

For i = iRows To 1 Step -1

If Cells(i, 1) = "" Then Rows(i).EntireRow.Delete

Next
If Licznik = 1 Then
Set Naglowki = Ark.Range("A1").CurrentRegion.Rows(1)
Naglowki.Copy Skonsolidowany.Range("A1")
Set KomDocel = Skonsolidowany.Range("A2")
Else
Set ZakresDocel = Skonsolidowany.Range("A1").CurrentRegion
LW_Docel = ZakresDocel.Rows.Count
Set KomDocel = Skonsolidowany.Cells(LW_Docel + 1, 1)
End If

Dodano po 8 [minuty]:

Makro zanim scala usuwa puste wiersze
2 razy należy zrealizować scalanie w tym samym arkuszu aby poprawnie połączyć wszystkie pliki

Sub Scalaj()
Dim Skonsolidowany As Worksheet
Dim Plik As String
Dim Skor As Workbook, Ark As Worksheet
Dim Pocz As Range, Kon As Range
Dim Naglowki As Range, Podzakres As Range, KomDocel As Range
Dim Licznik As Long, LW As Long, LK As Long
Dim ZakresDocel As Range, LW_Docel As Long
Dim Folder As String

Folder = WskazFolder("Wskaż folder z plikami do scalenia", "Scalaj")
If Len(Folder) = 0 Then
MsgBox "Nie wskazano foldera źródłowego", vbExclamation, WERSJA
Exit Sub
End If
Application.ScreenUpdating = True
Set Skonsolidowany = Worksheets.Add()
Plik = Dir(Folder & "*.xls")
Do Until Len(Plik) = 0
Licznik = Licznik + 1
Application.StatusBar = "Konsolidacja pliku nr " & Licznik
Set Skor = Workbooks.Open(Folder & Plik)
Set Ark = Skor.Sheets(1)

iRows = Sheets(1).UsedRange.Rows.Count + 1

For i = iRows To 1 Step -1

If Cells(i, 1) = "" Then Rows(i).EntireRow.Delete

Next
If Licznik = 1 Then
Set Naglowki = Ark.Range("A1").CurrentRegion.Rows(1)
Naglowki.Copy Skonsolidowany.Range("A1")
Set KomDocel = Skonsolidowany.Range("A2")
Else
Set ZakresDocel = Skonsolidowany.Range("A1").CurrentRegion
LW_Docel = ZakresDocel.Rows.Count
Set KomDocel = Skonsolidowany.Cells(LW_Docel + 1, 1)
End If

Set Podzakres = Ark.Range("A1").CurrentRegion
LW = Podzakres.Rows.Count + 1
LK = Podzakres.Columns.Count + 1
Set Podzakres = Range(Ark.Range("A2"), Ark.Cells(LW, LK))
Podzakres.Copy KomDocel
Skor.Close False
Plik = Dir
Loop
Skonsolidowany.Name = "Skonsolidowany" & StempelCzasowy
Skonsolidowany.UsedRange.EntireColumn.AutoFit
Skonsolidowany.Range("A1").Select

'Application.StatusBar = "Gotowy"
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox "Konsolidacja " & Licznik & " arkuszy zakończona", vbInformation, WERSJA
End Sub

Function StempelCzasowy() As String
StempelCzasowy = Format(Now(), "_yyyymmdd_hhmmss")
End Function

Function WskazFolder(TytulOkna As String, TytulPrzycisku As String) As String
Dim Okno As FileDialog
Dim Wybrane As String
Set Okno = Application.FileDialog(msoFileDialogFolderPicker)
Okno.Title = TytulOkna
Okno.ButtonName = TytulPrzycisku
If Okno.Show = -1 Then
Wybrane = Okno.SelectedItems(1)
If Right(Wybrane, 1) <> "\" Then
WskazFolder = Wybrane & "\"
Else
WskazFolder = Wybrane
End If
End If
End Function